Tk Japanization Patch This file is a patch for Tk4.2 to be Japanized. The Japanization of Tk4.2 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 Tk4.2 source code - Tk widgets are modified to display, input and cut&paste kanji string. See the documents included in this patch for details. To apply this patch, you should cd to the top directory of the Tk4.2 source tree (the directory containing tk*.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/TkJP.man doc.jp/TkJP.jman library/kinput.tcl generic/tkCtext.c generic/tkWStr.c generic/tkWStr.h unix/tkKinput2.c unix/tkKinput2.h If you are using a symbolic link tree, you will need to create new links. You may need to specify the Tcl directory when you run `configure' script. I usually rename a Japanized Tcl source directory as `tcl7.6jp'. In this case, you have to run `configure' script as follows: % ./configure --with-tcl=../../tcl7.6jp/unix Except this, just follow the steps of the original Tk. 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 Tk4.2jp 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 \$ ../tk4.2/README.JP ./README.JP *** ../tk4.2/README.JP Thu Jan 1 09:00:00 1970 --- ./README.JP Fri Oct 18 13:14:41 1996 *************** *** 0 **** --- 1,94 ---- + The Japanization of Tk + + 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 Tk to handle Japanese characters + (kanji). + + The patch kit contains: + + + Modifications to the Tk4.1 source code + - Tk widgets are modified to display, input and cut&paste kanji + string. + + A document describing the specification of the kanji handling in Tk + (Both Japanese and English versions are provided for your convenience). + + 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: + + + Every Tk widget can handle kanji strings which can contain both kanji + (Shift-JIS, JIS, EUC) and ascii encoded characters. + + It conforms to the ICCCM for string encoding (COMPOUND_TEXT) on data + exchange so that it can exchange data with other applications which also + conform to the ICCCM. + + Users are allowed to input kanji strings via kinput2 (The popular input + method which is included in the X11's user contributed software). + + Canvas widgets can also generate kanji PostScript(tm) outputs. + + Please refer to the document for details. + + + 3. Compile & Installation + ------------------------- + + You may need to specify the Tcl directory when you run `configure' script. I + usually rename a Japanized Tcl source directory as `tcl7.5jp'. In this case, + you have to run `configure' script as follows: + + % ./configure --with-tcl=../../tcl7.5jp/unix + + Except this, just follow the steps of the original Tk. + + Note that this Japanization introduces 5 new source files (tkWStr.[ch], + tkKinput2.[ch] and tkCtext.c), and requires two additional compiler flags + (-DKANJI and -DKINPUT2). So if you don't use `configure' to generate the + default Makefile (i.e. using customized one), don't forget to modify it + accordingly. + + Some of the library files (usually installed in "/usr/local/lib/tk") are + modified for the Japanization. Since these modifications do not affect + anything about the behavior of the original Tk, any scripts for the original + version can also work with the libraries of this Japanized Tk. + + + 4. Test + ------- + + No test suite is provied for the Japanized Tk. + + You can try the Japanese translation of the widget demo and see how it works. + You will find the Japanese translation of the widget demo at the next to the + usual demo directory by the name `demos.jp'. + + + 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 \$ ../tk4.2/changes.JP ./changes.JP *** ../tk4.2/changes.JP Thu Jan 1 09:00:00 1970 --- ./changes.JP Sun Nov 24 14:54:22 1996 *************** *** 0 **** --- 1,138 ---- + Release tk4.2jp, November 24, 1996 + + (new release) Modified for the Tk4.2. + + (new release) Modified for the Tk4.1p1. + + (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()). + + (bug fix) Bug fixes for Windows version (by Mr. Hiroaki NAKAMURA). + + Release tk4.1jp_alpha, April 25, 1996 + + (new release) Modified for the Tk4.1. + + (new feature) A set of patches for Windows is contributed from + Mr. Hiroaki NAKAMURA. + + (new release) Modified for the Tk4.1b3. + + (new release) Modified for the Tk4.1b1. + + (new release) Modified for the Tk4.1a2. + + Release tk4.0p3jp, December 11, 1995 + + (bug fix) Fixed a bug in 'library/prolog.ps'. Now you can generate a + PostScript including kanji characters. + + (bug fix) Fixed a bug in tag priority of Text Widgets. If you specify + a kanji font with a tag, and then specify a ascii font with another tag, + kanji strings are displayed with the default kanji font. + + Release tk4.0jp, September 25, 1995 + + (bug fix) Fixed a bug in TkTextCharLayoutProc. 'ciPtr' was accidentally + allocated twice. + + (bug fix) Fixed a bug in ConfigureScale. 'gcValues.foreground' was + accidentally unitialized for 'scalePtr->troughGC'. + + (new features) For window managers that can handle compound text, wm command + now convert a string from STRING to COMPOUND_TEXT if the string contains + kanji characters. Mr. Motonori Hirano (m-hirano@sra.co.jp) contributed this + patch. + + (bug fix) Fixed a bug in the insert option of text widgets. Even if you + specify a tag for some attributes of text, sometimes it doesn't affect on + its appearence. + + (bug fix) Fixed a bug in tkWStr.c Use memset insted of bzero. + + (bug fix) Fixed a bug in tkMenu.c. Mismatched #endif remains a trace on a + variable which does not exist. + + Release tk4.0jp-beta, August 1, 1995 + + (bug fix) Fixed bug in TkWSTextExtents. The initial value of lbearing should + not be 0. + + (new release) Modified some test suites which generate errors according to + the kanji font. + + Release tk4.0jp-alpha, July 12, 1995 + + (new release) Lots of modifications according to the new release. + + Release tk3.6jp-update3, May 24, 1995 + + (bug fix) Handling of -font/-kanjifont options for text tags were incorrect. + the results of Tk_GetFontStruct() cannot be simply copied, + because of the reference counting. + + (bug fix) Tk_GetFontStruct takes Tk_Uid, not just "char *" for the fontname. + This bug causes an unnecessary XLoadQueryFont every time kanjiInput start/ + attribute command is invoked. + + (bug fix) Fixed bug in EntryFetchSelection to free memory properly. + + (bug fix) Fixed a bug in library/kinput.tcl. If font name contains blank + characters, over-the-spot type input causes some warning messages. + + (bug fix) When the kana-kanji converion is taking place, tk doesn't restore + the window field of forwarded key events, causing bind command to be confused. + + Release tk3.6jp-update2, August 25, 1994 + + (bug fix) The declaration of checkProtocol() has been taken out of a + function block. + + Release tk3.6jp-update1, February 14, 1994 + + (bug fix) Fixed bug in tkKinput2.c for systems (some 64bit CPUs including + DEC/Alpha) where 'sizeof(long)' > 4. + + (bug fix) Fixed 'xypos' widget command in tkTextDisp.c to handle folded + long lines correctly. + + (bug fix) TK_CONFIG_END had a different definition from the original. + This might cause some troubles when the user mixes the Japanization and + other extensions. + + (bug fix) Moved 'tkWStr.h' out of 'tk.h' since 'tk.h' is installed to the + system directory but 'tkWStr.h' is not. + + (bug fix) Eliminated every 'bstring' functions. + + Release tk3.6jp, December 7, 1993 + + (bug fix) Canvases couldn't generate correct PS outputs when the kanji font + doesn't have XLFD name. + + (bug fix) The caching of kanji fonts was incorrect. + + (new feature) Modified tkFont.c and tkWStr.c to handle ISO Latin1 encodings. + + (new feature) Modified tkKinput2.c to forward the key event on the widget to + the input server (i.e. kinput2). Thus the user doesn't have to move the + mouse cursor to the window of the input server. + + (bug fix) When several widgets require kanji input at a time, the input + server sent the conversion result to the wrong widget. + + (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 tkKinput2.c to initialize the number of specified + attributes. + + (bug fix) Clone interpreter needs current position to be set before + executing 'cshow'. + + Release tk3.2jp-update1, August 26, 1993 + + Release tk3.2jp, July 9, 1993 diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/doc.jp/README ./doc.jp/README *** ../tk4.2/doc.jp/README Thu Jan 1 09:00:00 1970 --- ./doc.jp/README Fri Oct 18 13:14:42 1996 *************** *** 0 **** --- 1,11 ---- + This directory contains the following documents: + + TkJP.man -- overview of the Tk Japanization (written in English) + TkJP.jman -- overview of the Tk Japanization (written in Japanese) + + Note: + + + The Japasese document (TkJP.jman) are encoded in EUC kanji code. + + All three 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 \$ ../tk4.2/doc.jp/TkJP.jman ./doc.jp/TkJP.jman *** ../tk4.2/doc.jp/TkJP.jman Thu Jan 1 09:00:00 1970 --- ./doc.jp/TkJP.jman Fri Oct 18 13:14:42 1996 *************** *** 0 **** --- 1,264 ---- + '\" + '\" 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: TkJP.jman,v 1.1 1995/12/21 08:30:29 hoshi Exp $ + ' + .so man.macros + .de UL + \\$1\l'|0\(ul'\\$2 + .. + .HS TkJP tk + .if n .na + .BS + .SH "名前" + TkJapanization \- overview of Tk Japanization + .BE + + .SH "はじめに" + このドキュメントでは Tk に対して行った日本語化の概要を説明します。 + 日本語化の作業概要は次の通りです。 + .RS + .nf + + ・widget での日本語の表示・入力、カットアンドペースト。 + ・キャンバス widget の PS 出力で日本語が扱える。 + + .fi + .RE + 日本語化は + 「できるだけ漢字コードなど細かいことを意識せずに + 使うことができるようにする」、「オリジナル版用にかかれたスクリプトも + できるだけそのまま動作するようにする」という方針のもとに + 行いました。 + ' + .SH "日本語の表示" + 次に示す各 widget で日本語の表示ができます。 + .RS + .nf + + button, checkbutton, menubutton, radiobutton + canvas (text アイテム) + entry, text + label + listbox + menu + message + scale + .fi + .RE + .PP + 以上の各 widget には漢字フォントを指定するためのリソースおよびオプションが + 追加されています。リソース名は \fBkanjiFont\fP、リソースクラス名は + \fBKanjiFont\fP、オプションは \fB-kanjifont\fP です。 + .PP + これらの widget のデフォルトの ASCII フォントと + 漢字フォントは \fBa14\fP と \fBk14\fP になっています。 + これはファイル "default.h" で定義されているので、このファイルを修正して + 再コンパイルすることにより変更可能です。 + ' + .SH "日本語の入力" + Tk では日本語用入力サーバを利用して日本語入力をすることが + できます。現在サポートされている入力サーバは \fBkinput2\fP だけです。 + 入力機能は個々の widget に組み込むのではなく、 + \fBkanjiInput\fP というコマンドを追加することで実現しています。 + .TP 4 + \fBkanjiInput \fIoption\fR ?\fIarg ...\fR? + このコマンドは入力サーバと通信し、 + 日本語入力に関する操作を行います。 + \fIoption\fR 引数でどんな操作を行なうのかを指定します。 + 指定できる値は: + .RS + .TP 4 + \fBkanjiInput start \fIclientWindow\fR ?\fIattributes ...\fR? + 入力サーバに変換開始をリクエストすることで日本語入力を開始します。 + 引数 \fIclientWindow\fR には変換を行いたい widget のパス名を指定します。 + \fIattributes\fP には入力サーバに与える属性を指定します。 + どのような属性があるかは入力サーバに依存します。 + 入力サーバに kinput2 を使用した時には次のような属性が指定できます。 + .RS + .TP 4 + \fB\-variable\fP \fIvariable-name\fP + 変換結果を指定した \fIvariable-name\fP で指定されるグローバル変数に格納します。 + この変数にトレースを掛けることによって、変換文字列が得られた時に + 適当な処理をすることができます。 + .br + この属性はどの入力サーバにも共通です。この他の属性は入力サーバに + 依存します。 + .TP 4 + \fB\-inputStyle\fP \fIstyle\fP + 入力スタイルを指定します。 + \fIstyle\fP として指定可能なのは \fBroot\fP、\fBoff\fP、\fBover\fP の + 3種類で、それぞれルートウィンドウ方式 (変換用のウィンドウが別に出る)、 + off-the-spot 方式 (指定した変換用の領域で変換を行う)、over-the-spot 方式 + (いわゆるその場変換) になります。 + .TP 4 + \fB\-foreground\fP \fIcolor\fP + 変換時に使用する前景色を指定します。 + kinput2 の場合、これはその場変換時のみ有効です。 + .TP 4 + \fB\-background\fP \fIcolor\fP + 変換時に使用する背景色を指定します。 + kinput2 の場合、これはその場変換時のみ有効です。 + .TP 4 + \fB\-clientArea\fP \fIarea\fP + クライアントの描画領域を指定します。 + \fIarea\fP は 4つの要素からなるリストで、領域を + .br + \ \ {X座標\ \ Y座標\ \ 幅\ \ 高さ} + .br + で表します。座標は \fIclientWindow\fR からの相対座標です。 + .TP 4 + \fB\-statusArea\fP \fIarea\fP + 変換ステータスの表示領域を指定します。 + \fIarea\fP の指定方法は \fB-clientArea\fP と同じです。 + .TP 4 + \fB\-focusWindow\fP \fIwindow\fP + 実際に入力を行うウィンドウを指定します。これは \fBclientWindow\fP か + またはそのサブウィンドウでなければなりません。 + 指定しなければ \fBclientWindow\fP が指定されたものとみなされます。 + .TP 4 + \fB\-fonts\fP \fIfont-list\fP + 使用するフォント名のリストを指定します。 + 一般的には ASCII 用のフォントと漢字用のフォントのリストを指定します。 + 順番は関係ありません。 + .TP 4 + \fB\-lineSpacing\fP \fIspacing\fP + 行の高さを指定します。指定単位はドットです。 + .TP 4 + \fB\-spot\fP \fIspot\fP + 描画開始位置の座標を指定します。 + \fIspot\fP は 2つの要素からなるリストで、 + .br + \ \ {X座標\ \ Y座標} + .br + として表され、通常 Text および Entry の \fBxypos\fP という + widget コマンドが返す値をそのまま用いることができます。 + 座標は \fIclientWindow\fR からの相対座標です + .TP 4 + \fB\-cursor\fP \fIcursor\fP + カーソルを指定します。\fIcursor\fP に指定できる形式は、 + \fBTk_GetCursor()\fP に指定できるものと同じです。 + .TP 4 + \fB\-eventCaptureMethod\fP \fImethod\fP + 入力サーバのイベント取得形式を指定します。指定できるのは + \fBnone\fP、\fBinputOnly\fP、\fBfocusSelect\fP の 3種類です。 + 指定しなかった時は \fBinputOnly\fP が使用されます。 + 現在の実装では \fBinputOnly\fP 以外の値では正しく動作しません。 + \fBnone\fP と \fBfocusSelect\fP は指定しないようにしてください。 + .RE + .TP 4 + \fBkanjiInput attribute \fIclientWindow\fR ?\fIattributes ...\fR? + .TP 4 + \fBkanjiInput attribute \fIclientWindow\fR ?\fIattribute-name\fR? + 属性値を変更したり、現在設定されている属性値の値を調べたりします。 + 上の形式では、\fIattributes\fP は入力サーバに与える属性で、 + \fBkanjiInput start\fP と同じように指定します。 + この場合指定された属性値が変更されます。 + .br + 下の形式で \fIattribute-name\fR は属性名です。 + 例えば入力スタイルの属性名は \fB\-inputStyle\fP です。指定された + 属性の値を返します。 + もし属性名の指定が省略された場合には全ての属性名とその値からなる + リストを返します。 + .TP 4 + \fBkanjiInput end \fIclientWindow\fR + 現在行われている変換入力を強制的に中止します。 + .RE + .PP + ここにあげた全ての属性が全て有効であるとは限りません。 + 例えば kinput2 は入力スタイルが \fBroot\fP の時には + フォントや色の指定を無視します。 + .PP + その場変換のサポートのために Text および Entry に \fBxypos\fP という + widget コマンドが追加されています。 + .TP 4 + \fIpassName\fP \fBxypos\fP \fIindex\fP + \fIindex\fP で指定される位置の XY 座標を \fI{x y}\fP という + リスト形式で返します。もし指定された位置がウィンドウの外にある場合には + 空のリストを返します。 + .PP + Text と Entry に関しては、Tk の初期化の際に実行されるスクリプト + .B kinput.tcl + で日本語入力の設定が自動的に行われます。 + デフォルトでは Text はその場入力、Entry はルートウィンドウ方式を使用し、 + それぞれ「コントロール-漢字」、「コントロール-バックスラッシュ」、 + 「コントール-右シフト」の各キーで日本語入力が始まるように設定してあります。 + このデフォルトのキーバインディングを変えたい時には "kinput.tcl" を変更 + してください。 + ' + .SH "日本語のカットアンドペースト" + セレクションで COMPOUND_TEXT を扱えるように拡張し、日本語のカットアンド + ペーストができるようになっています。 + .PP + Text、Entry、Listbox、Canvas (text アイテム) の各 widget は、 + セレクションのターゲットとして + .B STRING + 以外に + .B TEXT + と + .B COPOUND_TEXT + を受け付けます。TEXT または COMPOUND_TEXT が指定された場合には日本語も + カットアンドペーストできます。STRING が指定された場合には ASCII 文字 + の部分のみが転送されます。 + .PP + \fBselection\fP コマンドは次のように変更されています。 + .TP 4 + \fBselection get\fR ?\fItype\fR? + オリジナルでは \fItype\fR を省略した時には + .B STRING + が使われましたが、これでは日本語が扱えないため、省略時は + .B COMPOUND_TEXT + を使うようになっています。COMPOUND_TEXT の場合、\fBselection get\fP コマンドは + COMPOUND_TEXT から内部コードへの変換を行います。従ってこのコマンドは + 内部コードで表された文字列を返します。 + .TP 4 + \fBselection handle\fR \fIwindow\fR \fIcommand\fP ?\fItype\fR? ?\fIformat\fR? + \fItype\fR と \fIformat\fR の省略時の値がそれぞれ + .B STRING + から + .B COMPOUND_TEXT + に変更されました。\fIformat\fR が + .B COMPOUND_TEXT + または + .B TEXT + の場合、\fIcommand\fP が返す文字列は内部コードから COMPOUND_TEXT に + 自動的に変換されます。 + ' + .SH "キャンバスの PS 出力" + キャンバス widget ではその内容をポストスクリプト形式で出力することができ、 + ここも日本語化してあります。 + ただフォントの選択で、オリジナルでは X のフォントのファミリー名などから + 対応する PS のフォント名を生成するようになっていますが、 + 漢字フォントの場合には一般には対応する PS フォントがありません。 + そこで漢字のフォントは常に \fBRyumin-Light-H\fP を使用するように + してあります。このフォント名は "default.h" で定義されていますので、 + 変更するにはこのファイルを修正して再コンパイルしてください。 + ' + .SH "オリジナル版との共存" + 日本語化のために、通常 /usr/local/lib/tk の下にインストールされる + いくつかのファイルが変更されていますが、 + これらの変更はオリジナル版の動作には影響しないようにしてありますので、 + 日本語化版を同じ所にインストールしてもオリジナル版はそのまま動作する + はずです。 + ' + .SH "問題点" + この日本語化は X11R5 の国際化機能を一切使用していません。 + 特に入力機構である XIM を使用しておらず、日本語の入力は kinput2 を + 使わなくてはなりません。 + ' + .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 \$ ../tk4.2/doc.jp/TkJP.man ./doc.jp/TkJP.man *** ../tk4.2/doc.jp/TkJP.man Thu Jan 1 09:00:00 1970 --- ./doc.jp/TkJP.man Fri Oct 18 13:14:42 1996 *************** *** 0 **** --- 1,266 ---- + '\" + '\" 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: TkJP.man,v 1.1 1995/12/21 08:30:30 hoshi Exp $ + ' + .so man.macros + .de UL + \\$1\l'|0\(ul'\\$2 + .. + .HS TkJP tk + .if n .na + .BS + .SH NAME + TkJapanization \- overview of Tk Japanization + .BE + + .SH INTRODUCTION + This document provides an overview of the Japanization of Tk. + The Japanization includes the following features: + .RS + .nf + + * Modification of widgets to handle kanji strings. + * PostScript output of kanji strings for canvas widgets. + + .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 Tk are executable". + ' + .SH "DISPLAY KANJI STRINGS" + The following widgets can display kanji strings: + .RS + .nf + + button, checkbutton, menubutton, radiobutton + canvas (text item) + entry, text + label + listbox + menu + message + scale + .fi + .RE + .PP + These widgets have an additional resource and option for kanji fonts. + The resource name is \fBkanjiFont\fP, + the resource class name is \fBkanjiFont\fP, + and the option is \fB-kanjifont\fP. + .PP + The default ascii font and kanji font of these widgets are + \fBa14\fP and \fBk14\fP respectively. + These default fonts are defined in the file "default.h". + If you want to change them, + you need to modify the file and recompile Tk. + ' + .SH "KANJI INPUT" + This modification allows you to input kanji strings + by calling a kanji input server. + The only input server that the current implementation supports + is \fBkinput2\fP. + Instead of embedding the functions for kanji input into each widget, + we provided the \fBkanjiInput\fP command. + .TP 4 + \fBkanjiInput \fIoption\fR ?\fIarg ...\fR? + Perform one of several kanji input operations, + depending on \fIoption\fR. + The legal \fIoption\fRs are: + .RS + .TP 4 + \fBkanjiInput start \fIclientWindow\fR ?\fIattributes ...\fR? + Send a request for kanji input to the kanji input server. + The \fIclientWindow\fR is the widget path name + where you want to do the kanji input. + The \fIattributes\fP are the parameters to pass for the initialization + when you invoke the input server. + The \fIattributes\fP are dependent upon the input server. + For kinput2, the legal \fIattributes\fP are: + .RS + .TP 4 + \fB\-variable\fP \fIvariable-name\fP + The \fIvariable-name\fP is the name of the global variable + to which you want to assign the result of kanji input. + You can trace this variable and call specific procedures + to deal with the kanji string received from the input server. + .br + Every input server should have this attribute. + .TP 4 + \fB\-inputStyle\fP \fIstyle\fP + The \fIstyle\fP argument indicates the input style. + It may have any of the values: \fBroot\fP, \fBoff\fP, \fBover\fP + which mean "root window style input", + "off-the-spot style input", + "over-the-spot style input" + respectively. + .TP 4 + \fB\-foreground\fP \fIcolor\fP + Specifies the foreground color of the kanji input area. + For kinput2, this attribute is effective + only when you choose the "over-the-spot style input". + .TP 4 + \fB\-background\fP \fIcolor\fP + Specifies the background color of the kanji input area. + For kinput2, this attribute is effective + only when you choose the "over-the-spot style input". + .TP 4 + \fB\-clientArea\fP \fIarea\fP + Specifies the area for kanji input. + \fIarea\fP is a list of four elements: + .br + \ \ {x\ \ y\ \ width\ \ height} + .br + Coordinates are relative to the \fIclientWindow\fR. + .TP 4 + \fB\-statusArea\fP \fIarea\fP + Specifies the area for showing the status of kanji input. + The \fIarea\fP is specified in the same way as for \fB-clientArea\fP. + .TP 4 + \fB\-focusWindow\fP \fIwindow\fP + Specifies the window where you want to do the kanji input. + The \fIwindow\fP should be the \fIclientWindow\fP or its subwindow. + The default window is the \fIclientWindow\fP. + .TP 4 + \fB\-fonts\fP \fIfont-list\fP + Specifies the list of font names to use for kanji input. + Usually you need to specify both ascii font and kanji font. + The order of the list elements have no meaning. + .TP 4 + \fB\-lineSpacing\fP \fIspacing\fP + Specifies the height of a line on kanji input area. + The value of \fIspacing\fP is the number of dots. + .TP 4 + \fB\-spot\fP \fIspot\fP + Specifies the XY-coordinates of the spot location of the conversion. + \fISpot\fP is a list of the following form: + .br + \ \ {X-coordinate\ \ Y-coordinate} + .br + It is the same format as the return value of the \fBxypos\fP + widget command of Text and Entry widgets. + These coordinates are relative to the coordinates of + the \fIclientWindow\fR. + .TP 4 + \fB\-cursor\fP \fIcursor\fP + Specifies the shape of the cursor. + The value of \fIcursor\fP is same as for \fBTk_GetCursor()\fP. + .TP 4 + \fB\-eventCaptureMethod\fP \fImethod\fP + Specifies the style to capture events from input server. + It may have any of the values: + \fBnone\fP, \fBinputOnly\fP, and \fBfocusSelect\fP. + The default value is \fBinputOnly\fP. + Actually the current implementation of kinput2 only supports \fBinputOnly\fP. + .RE + .TP 4 + \fBkanjiInput attribute \fIclientWindow\fR ?\fIattributes ...\fR? + .TP 4 + \fBkanjiInput attribute \fIclientWindow\fR ?\fIattribute-name\fR? + These two return or change the current attributes of the kanji input server. + In the first form, \fIattributes\fP are passed to the kanji input server, + just as for \fBkanjiInput start\fP. + In this case, the value of the specifed attributes will be changed. + .br + In the second form, \fIattribute-name\fR is a name of an attribute. + For example, the attribute name for input style is "\fB\-inputStyle\fP". + In this case, the command returns the current value of the attribute. + If no attribute name is specifed, + then returns a list of all attribute names and values. + .TP 4 + \fBkanjiInput end \fIclientWindow\fR + Terminate the current kanji input. + .RE + .PP + Not all of these attributes are always effective. + For example, if the input style is \fBroot\fP, + then the specifications of fonts or colors are meaningless. + .PP + For over-the-spot style input, + Text and Entry widgets now have a new command \fBxypos\fP. + .TP 4 + \fIpassName\fP \fBxypos\fP \fIindex\fP + Returns the coordinates of the position specified by \fIindex\fP + in a form of a list \fI{x y}\fP. + If the specified position is out of the window, + then returns a null list. + .PP + Initial bindings for Text and Entry widgets are given by the file "kinput.tcl" + which is loaded for the initialization of \fBwish\fP. + The default input style is "over-the-spot" for Text widgets + and "root" for Entry widgets. + The default key bindings to start kanji input are + , and . + If you want to change these defaults, + please look at the file "kinput.tcl" and modify it. + ' + .SH "CUT&PASTE KANJI STRINGS" + Selection is extended to be able to handle COMPOUND_TEXT + and you can cut & paste kanji strings. + .PP + Text, Entry, Listbox and Canvas (text item) now accept + \fBTEXT\fP and \fBCOMPOUND_TEXT\fP as for a selection target. + If \fBTEXT\fP or \fBCOMPOUND_TEXT\fP is specified, + you can cut & paste kanji strings. + If \fBSTRING\fP is specified, + all you can get is ascii strings. + .PP + The \fBselection\fP command is modified as follows: + .TP 4 + \fBselection get\fR ?\fItype\fR? + The \fItype\fR defaults to \fBSTRING\fP in the original Tk. + To handle kanji strings, we modified the default to \fBCOMPOUND_TEXT\fP. + When the selection target is \fBCOMPOUND_TEXT\fP, + \fBselection get\fP command converts the string + from \fBCOMPOUND_TEXT\fP to internal code. + Thus the command returns the strings encoded with internal code. + .TP 4 + \fBselection handle\fR \fIwindow\fR \fIcommand\fP ?\fItype\fR? ?\fIformat\fR? + The default of \fItype\fR and \fIformat\fR is now \fBCOMPOUND_TEXT\fP. + When the \fIformat\fR is either \fBCOMPOUND_TEXT\fP or \fBTEXT\fP, + \fIcommand\fP converts the string from internal code to \fBCOMPOUND_TEXT\fP. + ' + .SH "POSTSCRIPT OUTPUT FROM CANVAS WIDGET" + The modification includes the PostScript generation of + text items on canvas widgets. + The original Tk generates a PostScript font name + from a family name of the X font, + but unfortunately there is no kanji PostScript font name + corresponding to the X kanji fonts. + So the current implementation always uses \fBRyumin-Light-H\fP + for any kanji fonts. + This is defined in the file "default.h". + If you want to change it, + you need to modify the file and recompile Tk. + ' + .SH "COEXISTING WITH THE ORIGINAL TCL/TK" + Some of the library files (usually installed in "/usr/local/lib/tk") + are modified for the Japanization. + Since these modifications do not affect anything about + the behavior of the original Tcl/Tk, + the original version can work with the libraries of this Japanized Tcl/Tk. + ' + .SH PROBLEMS + The Japanization does not use the internationalization features of X11R5 at all. + So the kinput2 (which does not depend on the XIM) + is the only Japanese text input method with the current implementation. + ' + .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 \$ ../tk4.2/generic/tk.h ./generic/tk.h *** ../tk4.2/generic/tk.h Thu Oct 3 09:21:11 1996 --- ./generic/tk.h Fri Oct 18 13:14:43 1996 *************** *** 227,232 **** --- 227,235 ---- #define TK_CONFIG_WINDOW 20 #define TK_CONFIG_CUSTOM 21 #define TK_CONFIG_END 22 + #ifdef KANJI + #define TK_CONFIG_WSTRING 23 + #endif /* KANJI */ /* * Macro to use to fill in "offset" fields of Tk_ConfigInfos. *************** *** 722,727 **** --- 725,733 ---- int cursorOn; /* Non-zero means that an insertion cursor * should be displayed in focusItemPtr. * Read-only to items.*/ + #ifdef KANJI + int use_ctext; /* If true, use Compound Text for selection. */ + #endif /* KANJI */ } Tk_CanvasTextInfo; /* *************** *** 918,923 **** --- 924,943 ---- #define Tk_Preserve Tcl_Preserve #define Tk_Release Tcl_Release + #ifdef KANJI + /* + *-------------------------------------------------------------- + * + * Declarations for things that are related to the wide strings. + * + *-------------------------------------------------------------- + */ + #ifndef _TKWSTR + #include "tkWStr.h" + #endif + + #endif /* KANJI */ + /* *-------------------------------------------------------------- * *************** *** 979,986 **** --- 999,1012 ---- int width, int height)); EXTERN int Tk_CanvasPsColor _ANSI_ARGS_((Tcl_Interp *interp, Tk_Canvas canvas, XColor *colorPtr)); + #ifdef KANJI + EXTERN int Tk_CanvasPsFont _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Canvas canvas, XFontStruct *fontStructPtr, + char *fontTypeName)); + #else EXTERN int Tk_CanvasPsFont _ANSI_ARGS_((Tcl_Interp *interp, Tk_Canvas canvas, XFontStruct *fontStructPtr)); + #endif /* KANJI */ EXTERN void Tk_CanvasPsPath _ANSI_ARGS_((Tcl_Interp *interp, Tk_Canvas canvas, double *coordPtr, int numPoints)); EXTERN int Tk_CanvasPsStipple _ANSI_ARGS_((Tcl_Interp *interp, *************** *** 1196,1201 **** --- 1222,1237 ---- EXTERN int Tk_Init _ANSI_ARGS_((Tcl_Interp *interp)); EXTERN Atom Tk_InternAtom _ANSI_ARGS_((Tk_Window tkwin, char *name)); + #if defined(KANJI) && defined(KINPUT2) + EXTERN int Tk_Kinput2Start _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Window tkwin, int argc, char **argv)); + EXTERN int Tk_Kinput2End _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Window tkwin)); + EXTERN int Tk_Kinput2Attribute _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Window tkwin, int argc, char **argv)); + EXTERN int Tk_Kinput2AttributeInfo _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Window tkwin, char *attrName)); + #endif /* KANJI && KINPUT2 */ EXTERN void Tk_Main _ANSI_ARGS_((int argc, char **argv, Tcl_AppInitProc *appInitProc)); EXTERN void Tk_MainLoop _ANSI_ARGS_((void)); *************** *** 1304,1309 **** --- 1340,1365 ---- Tk_Window master)); EXTERN void Tk_UnmapWindow _ANSI_ARGS_((Tk_Window tkwin)); EXTERN void Tk_UnsetGrid _ANSI_ARGS_((Tk_Window tkwin)); + #ifdef KANJI + EXTERN XWSFontSet * Tk_GetFontSet _ANSI_ARGS_((XFontStruct *asciiFontPtr, + XFontStruct *kanjiFontPtr)); + EXTERN void Tk_FreeFontSet _ANSI_ARGS_((XWSFontSet *fontset)); + EXTERN XWSGCSet * Tk_GetGCSet _ANSI_ARGS_((Tk_Window tkwin, + unsigned long valueMask, XGCValues *valuePtr, + XWSFontSet *fontset)); + EXTERN void Tk_FreeGCSet _ANSI_ARGS_((Display *display, XWSGCSet *gcset)); + EXTERN wchar * Tk_GetWStr _ANSI_ARGS_((Tcl_Interp *interp, char *str)); + EXTERN void Tk_FreeWStr _ANSI_ARGS_((wchar *wstr)); + EXTERN wchar * Tk_InsertWStr _ANSI_ARGS_((Tcl_Interp *interp, + wchar *orig, int index, wchar *wstr)); + EXTERN wchar * Tk_DeleteWStr _ANSI_ARGS_((Tcl_Interp *interp, + wchar *orig, int index, int count)); + EXTERN char * Tk_DecodeWStr _ANSI_ARGS_((wchar *wstr)); + + EXTERN char * Tk_WStrToString _ANSI_ARGS_((wchar *ws, int n)); + EXTERN char * Tk_WStrToCtext _ANSI_ARGS_((wchar *ws, int n)); + EXTERN wchar * Tk_CtextToWStr _ANSI_ARGS_((char *ct, int n)); + #endif /* KANJI */ /* * Tcl commands exported by Tk: *************** *** 1351,1356 **** --- 1407,1416 ---- Tcl_Interp *interp, int argc, char **argv)); EXTERN int Tk_ImageCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int argc, char **argv)); + #ifdef KANJI + EXTERN int Tk_KanjiInputCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); + #endif /* KANJI */ EXTERN int Tk_LabelCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int argc, char **argv)); EXTERN int Tk_ListboxCmd _ANSI_ARGS_((ClientData clientData, diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/generic/tkButton.c ./generic/tkButton.c *** ../tk4.2/generic/tkButton.c Tue Aug 27 02:09:35 1996 --- ./generic/tkButton.c Fri Oct 18 13:14:44 1996 *************** *** 39,46 **** --- 39,50 ---- * Information about what's in the button. */ + #ifdef KANJI + wchar *text; + #else char *text; /* Text to display in button (malloc'ed) * or NULL. */ + #endif /* KANJI */ int numChars; /* # of characters in text. */ int underline; /* Index of character to underline. < 0 means * don't underline anything. */ *************** *** 88,113 **** --- 92,132 ---- * Indicates how much interior stuff must * be offset from outside edges to leave * room for borders. */ + #ifdef KANJI + XWSFontSet *fontPtr; /* Information about text font, or NULL. */ + XFontStruct *asciiFontPtr; /* Information about ascii text font, or NULL. */ + XFontStruct *kanjiFontPtr; /* Information about kanji text font, or NULL. */ + #else XFontStruct *fontPtr; /* Information about text font, or NULL. */ + #endif /* KANJI */ XColor *normalFg; /* Foreground color in normal mode. */ XColor *activeFg; /* Foreground color in active mode. NULL * means use normalFg instead. */ XColor *disabledFg; /* Foreground color when disabled. NULL * means use normalFg with a 50% stipple * instead. */ + #ifdef KANJI + XWSGC normalTextGC; + XWSGC activeTextGC; + #else GC normalTextGC; /* GC for drawing text in normal mode. Also * used to copy from off-screen pixmap onto * screen. */ GC activeTextGC; /* GC for drawing text in active mode (NULL * means use normalTextGC). */ + #endif /* KANJI */ Pixmap gray; /* Pixmap for displaying disabled text if * disabledFg is NULL. */ + #ifdef KANJI + XWSGC disabledGC; + #else GC disabledGC; /* Used to produce disabled effect. If * disabledFg isn't NULL, this GC is used to * draw button text or icon. Otherwise * text or icon is drawn with normalGC and * this GC is used to stipple background * across it. For labels this is None. */ + #endif /* KANJI */ GC copyGC; /* Used for copying information from an * off-screen pixmap to the screen. */ char *widthString; /* Value of -width option. Malloc'ed. */ *************** *** 272,280 **** --- 291,308 ---- |RADIO_BUTTON_MASK|TK_CONFIG_MONO_ONLY|TK_CONFIG_NULL_OK}, {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL, (char *) NULL, 0, ALL_MASK}, + #ifdef KANJI + {TK_CONFIG_FONT, "-font", "font", "Font", + DEF_BUTTON_FONT, Tk_Offset(Button, asciiFontPtr), + ALL_MASK}, + {TK_CONFIG_FONT, "-kanjifont", "kanjiFont", "KanjiFont", + DEF_BUTTON_KANJIFONT, Tk_Offset(Button, kanjiFontPtr), + ALL_MASK}, + #else {TK_CONFIG_FONT, "-font", "font", "Font", DEF_BUTTON_FONT, Tk_Offset(Button, fontPtr), ALL_MASK}, + #endif /* KANJI */ {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground", DEF_BUTTON_FG, Tk_Offset(Button, normalFg), ALL_MASK}, {TK_CONFIG_STRING, "-height", "height", "Height", *************** *** 342,349 **** --- 370,382 ---- {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus", DEF_BUTTON_TAKE_FOCUS, Tk_Offset(Button, takeFocus), BUTTON_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|TK_CONFIG_NULL_OK}, + #ifdef KANJI + {TK_CONFIG_WSTRING, "-text", "text", "Text", + DEF_BUTTON_TEXT, Tk_Offset(Button, text), ALL_MASK}, + #else {TK_CONFIG_STRING, "-text", "text", "Text", DEF_BUTTON_TEXT, Tk_Offset(Button, text), ALL_MASK}, + #endif /* KANJI */ {TK_CONFIG_STRING, "-textvariable", "textVariable", "Variable", DEF_BUTTON_TEXT_VARIABLE, Tk_Offset(Button, textVarName), ALL_MASK|TK_CONFIG_NULL_OK}, *************** *** 552,564 **** --- 585,610 ---- butPtr->highlightColorPtr = NULL; butPtr->inset = 0; butPtr->fontPtr = NULL; + #ifdef KANJI + butPtr->asciiFontPtr = NULL; + butPtr->kanjiFontPtr = NULL; + #endif /* KANJI */ butPtr->normalFg = NULL; butPtr->activeFg = NULL; butPtr->disabledFg = NULL; + #ifdef KANJI + butPtr->normalTextGC = NULL; + butPtr->activeTextGC = NULL; + #else butPtr->normalTextGC = None; butPtr->activeTextGC = None; + #endif /* KANJI */ butPtr->gray = None; + #ifdef KANJI + butPtr->disabledGC = NULL; + #else butPtr->disabledGC = None; + #endif /* KANJI */ butPtr->copyGC = None; butPtr->widthString = NULL; butPtr->heightString = NULL; *************** *** 801,818 **** --- 847,884 ---- if (butPtr->selectImage != NULL) { Tk_FreeImage(butPtr->selectImage); } + #ifdef KANJI + if (butPtr->fontPtr != NULL ) { + Tk_FreeFontSet(butPtr->fontPtr); + } + #endif /* KANJI */ + #ifdef KANJI + if (butPtr->normalTextGC != NULL) { + Tk_FreeGCSet(butPtr->display, butPtr->normalTextGC); + } + if (butPtr->activeTextGC != NULL) { + Tk_FreeGCSet(butPtr->display, butPtr->activeTextGC); + } + #else if (butPtr->normalTextGC != None) { Tk_FreeGC(butPtr->display, butPtr->normalTextGC); } if (butPtr->activeTextGC != None) { Tk_FreeGC(butPtr->display, butPtr->activeTextGC); } + #endif /* KANJI */ if (butPtr->gray != None) { Tk_FreeBitmap(butPtr->display, butPtr->gray); } + #ifdef KANJI + if (butPtr->disabledGC != NULL) { + Tk_FreeGCSet(butPtr->display, butPtr->disabledGC); + } + #else if (butPtr->disabledGC != None) { Tk_FreeGC(butPtr->display, butPtr->disabledGC); } + #endif /* KANJI */ if (butPtr->copyGC != None) { Tk_FreeGC(butPtr->display, butPtr->copyGC); } *************** *** 858,863 **** --- 924,932 ---- { XGCValues gcValues; GC newGC; + #ifdef KANJI + XWSGC newGCSet; + #endif /* KANJI */ unsigned long mask; Tk_Image image; *************** *** 881,886 **** --- 950,959 ---- return TCL_ERROR; } + #ifdef KANJI + butPtr->fontPtr = Tk_GetFontSet(butPtr->asciiFontPtr, butPtr->kanjiFontPtr); + #endif /* KANJI */ + /* * A few options need special processing, such as setting the * background from a 3-D border, or filling in complicated *************** *** 904,910 **** --- 977,985 ---- butPtr->highlightWidth = 0; } + #ifndef KANJI gcValues.font = butPtr->fontPtr->fid; + #endif /* !KANJI */ gcValues.foreground = butPtr->normalFg->pixel; gcValues.background = Tk_3DBorderColor(butPtr->normalBorder)->pixel; *************** *** 915,920 **** --- 990,1004 ---- */ gcValues.graphics_exposures = False; + #ifdef KANJI + newGCSet = Tk_GetGCSet(butPtr->tkwin, + GCForeground|GCBackground|GCFont|GCGraphicsExposures, + &gcValues, butPtr->fontPtr); + if (butPtr->normalTextGC != NULL) { + Tk_FreeGCSet(butPtr->display, butPtr->normalTextGC); + } + butPtr->normalTextGC = newGCSet; + #else newGC = Tk_GetGC(butPtr->tkwin, GCForeground|GCBackground|GCFont|GCGraphicsExposures, &gcValues); *************** *** 922,942 **** --- 1006,1040 ---- Tk_FreeGC(butPtr->display, butPtr->normalTextGC); } butPtr->normalTextGC = newGC; + #endif /* KANJI */ if (butPtr->activeFg != NULL) { + #ifndef KANJI gcValues.font = butPtr->fontPtr->fid; + #endif /* KANJI */ gcValues.foreground = butPtr->activeFg->pixel; gcValues.background = Tk_3DBorderColor(butPtr->activeBorder)->pixel; + #ifdef KANJI + newGCSet = Tk_GetGCSet(butPtr->tkwin, + GCForeground|GCBackground, &gcValues, butPtr->fontPtr); + if (butPtr->activeTextGC != NULL) { + Tk_FreeGCSet(butPtr->display, butPtr->activeTextGC); + } + butPtr->activeTextGC = newGCSet; + #else newGC = Tk_GetGC(butPtr->tkwin, GCForeground|GCBackground|GCFont, &gcValues); if (butPtr->activeTextGC != None) { Tk_FreeGC(butPtr->display, butPtr->activeTextGC); } butPtr->activeTextGC = newGC; + #endif /* KANJI */ } if (butPtr->type != TYPE_LABEL) { + #ifndef KANJI gcValues.font = butPtr->fontPtr-> fid; + #endif /* KANJI */ gcValues.background = Tk_3DBorderColor(butPtr->normalBorder)->pixel; if ((butPtr->disabledFg != NULL) && (butPtr->imageString == NULL)) { gcValues.foreground = butPtr->disabledFg->pixel; *************** *** 954,964 **** --- 1052,1070 ---- gcValues.stipple = butPtr->gray; mask = GCForeground|GCFillStyle|GCStipple; } + #ifdef KANJI + newGCSet = Tk_GetGCSet(butPtr->tkwin, mask, &gcValues, butPtr->fontPtr); + if (butPtr->disabledGC != NULL) { + Tk_FreeGCSet(butPtr->display, butPtr->disabledGC); + } + butPtr->disabledGC = newGCSet; + #else newGC = Tk_GetGC(butPtr->tkwin, mask, &gcValues); if (butPtr->disabledGC != None) { Tk_FreeGC(butPtr->display, butPtr->disabledGC); } butPtr->disabledGC = newGC; + #endif /* KANJI */ } if (butPtr->copyGC == None) { *************** *** 1051,1056 **** --- 1157,1177 ---- char *value; value = Tcl_GetVar(interp, butPtr->textVarName, TCL_GLOBAL_ONLY); + #ifdef KANJI + if (value == NULL) { + if (Tcl_SetVar(interp, butPtr->textVarName, Tk_DecodeWStr(butPtr->text), + TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) { + return TCL_ERROR; + } + } else { + wchar *old = butPtr->text; + + butPtr->text = Tk_GetWStr(interp, value); + if (old != NULL) { + Tk_FreeWStr(old); + } + } + #else if (value == NULL) { if (Tcl_SetVar(interp, butPtr->textVarName, butPtr->text, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) { *************** *** 1063,1068 **** --- 1184,1190 ---- butPtr->text = (char *) ckalloc((unsigned) (strlen(value) + 1)); strcpy(butPtr->text, value); } + #endif /* KANJI */ Tcl_TraceVar(interp, butPtr->textVarName, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, ButtonTextVarProc, (ClientData) butPtr); *************** *** 1128,1134 **** --- 1250,1260 ---- ClientData clientData; /* Information about widget. */ { register Button *butPtr = (Button *) clientData; + #ifdef KANJI + XWSGC gc; + #else GC gc; + #endif /* KANJI */ Tk_3DBorder border; Pixmap pixmap; int x = 0; /* Initialization only needed to stop *************** *** 1233,1242 **** --- 1359,1375 ---- x, y); } } else { + #ifdef KANJI + XSetClipOrigin(butPtr->display, gc->fe[0].gc, x, y); + XCopyPlane(butPtr->display, butPtr->bitmap, pixmap, gc->fe[0].gc, 0, 0, + (unsigned int) width, (unsigned int) height, x, y, 1); + XSetClipOrigin(butPtr->display, gc->fe[0].gc, 0, 0); + #else XSetClipOrigin(butPtr->display, gc, x, y); XCopyPlane(butPtr->display, butPtr->bitmap, pixmap, gc, 0, 0, (unsigned int) width, (unsigned int) height, x, y, 1); XSetClipOrigin(butPtr->display, gc, 0, 0); + #endif /* KANJI */ } y += height/2; } else if (butPtr->bitmap != None) { *************** *** 1276,1284 **** --- 1409,1423 ---- x += offset; y += offset; } + #ifdef KANJI + TkWSDisplayText(butPtr->display, pixmap, butPtr->fontPtr, + butPtr->text, butPtr->numChars, x, y, butPtr->textWidth, + butPtr->justify, butPtr->underline, gc); + #else TkDisplayText(butPtr->display, pixmap, butPtr->fontPtr, butPtr->text, butPtr->numChars, x, y, butPtr->textWidth, butPtr->justify, butPtr->underline, gc); + #endif /* KANJI */ y += butPtr->textHeight/2; } *************** *** 1356,1372 **** --- 1495,1528 ---- && ((butPtr->disabledFg == NULL) || (butPtr->image != NULL))) { if ((butPtr->flags & SELECTED) && !butPtr->indicatorOn && (butPtr->selectBorder != NULL)) { + #ifdef KANJI + XSetForeground(butPtr->display, butPtr->disabledGC->fe[0].gc, + Tk_3DBorderColor(butPtr->selectBorder)->pixel); + #else XSetForeground(butPtr->display, butPtr->disabledGC, Tk_3DBorderColor(butPtr->selectBorder)->pixel); + #endif /* KANJI */ } + #ifdef KANJI + XFillRectangle(butPtr->display, pixmap, butPtr->disabledGC->fe[0].gc, + butPtr->inset, butPtr->inset, + (unsigned) (Tk_Width(tkwin) - 2*butPtr->inset), + (unsigned) (Tk_Height(tkwin) - 2*butPtr->inset)); + #else XFillRectangle(butPtr->display, pixmap, butPtr->disabledGC, butPtr->inset, butPtr->inset, (unsigned) (Tk_Width(tkwin) - 2*butPtr->inset), (unsigned) (Tk_Height(tkwin) - 2*butPtr->inset)); + #endif /* KANJI */ if ((butPtr->flags & SELECTED) && !butPtr->indicatorOn && (butPtr->selectBorder != NULL)) { + #ifdef KANJI + XSetForeground(butPtr->display, butPtr->disabledGC->fe[0].gc, + Tk_3DBorderColor(butPtr->normalBorder)->pixel); + #else XSetForeground(butPtr->display, butPtr->disabledGC, Tk_3DBorderColor(butPtr->normalBorder)->pixel); + #endif /* KANJI */ } } *************** *** 1559,1572 **** --- 1715,1739 ---- Tk_SizeOfBitmap(butPtr->display, butPtr->bitmap, &width, &height); goto imageOrBitmap; } else { + #ifdef KANJI + butPtr->numChars = Tcl_WStrlen(butPtr->text); + TkWSComputeTextGeometry(butPtr->fontPtr, butPtr->text, + butPtr->numChars, butPtr->wrapLength, &butPtr->textWidth, + &butPtr->textHeight); + #else butPtr->numChars = strlen(butPtr->text); TkComputeTextGeometry(butPtr->fontPtr, butPtr->text, butPtr->numChars, butPtr->wrapLength, &butPtr->textWidth, &butPtr->textHeight); + #endif /* KANJI */ width = butPtr->textWidth; height = butPtr->textHeight; if (butPtr->width > 0) { + #ifdef KANJI + width = butPtr->width * XTextWidth(butPtr->asciiFontPtr, "0", 1); + #else width = butPtr->width * XTextWidth(butPtr->fontPtr, "0", 1); + #endif /* KANJI */ } if (butPtr->height > 0) { height = butPtr->height * (butPtr->fontPtr->ascent *************** *** 1578,1585 **** --- 1745,1757 ---- if (butPtr->type == TYPE_CHECK_BUTTON) { butPtr->indicatorDiameter = (80*butPtr->indicatorDiameter)/100; } + #ifdef KANJI + butPtr->indicatorSpace = butPtr->indicatorDiameter + + XTextWidth(butPtr->asciiFontPtr, "0", 1); + #else butPtr->indicatorSpace = butPtr->indicatorDiameter + XTextWidth(butPtr->fontPtr, "0", 1); + #endif /* KANJI */ } } *************** *** 1681,1686 **** --- 1853,1861 ---- { register Button *butPtr = (Button *) clientData; char *value; + #ifdef KANJI + wchar *old = butPtr->text; + #endif /* KANJI */ /* * If the variable is being unset, then just re-establish the *************** *** 1755,1760 **** --- 1930,1938 ---- { register Button *butPtr = (Button *) clientData; char *value; + #ifdef KANJI + wchar *old = butPtr->text; + #endif /* KANJI */ /* * If the variable is unset, then immediately recreate it unless *************** *** 1763,1770 **** --- 1941,1953 ---- if (flags & TCL_TRACE_UNSETS) { if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) { + #ifdef KANJI + Tcl_SetVar(interp, butPtr->textVarName, + Tk_DecodeWStr(butPtr->text), TCL_GLOBAL_ONLY); + #else Tcl_SetVar(interp, butPtr->textVarName, butPtr->text, TCL_GLOBAL_ONLY); + #endif /* KANJI */ Tcl_TraceVar(interp, butPtr->textVarName, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, ButtonTextVarProc, clientData); *************** *** 1776,1786 **** --- 1959,1976 ---- if (value == NULL) { value = ""; } + #ifdef KANJI + butPtr->text = Tk_GetWStr(interp, value); + if (old != NULL) { + Tk_FreeWStr(old); + } + #else if (butPtr->text != NULL) { ckfree(butPtr->text); } butPtr->text = (char *) ckalloc((unsigned) (strlen(value) + 1)); strcpy(butPtr->text, value); + #endif /* KANJI */ ComputeButtonGeometry(butPtr); if ((butPtr->tkwin != NULL) && Tk_IsMapped(butPtr->tkwin) diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/generic/tkCanvPs.c ./generic/tkCanvPs.c *** ../tk4.2/generic/tkCanvPs.c Tue Oct 8 03:37:30 1996 --- ./generic/tkCanvPs.c Fri Oct 18 13:14:44 1996 *************** *** 17,22 **** --- 17,25 ---- #include "tkInt.h" #include "tkCanvas.h" #include "tkPort.h" + #ifdef KANJI + #include "default.h" + #endif /* KANJI */ /* * See tkCanvas.h for key data structures used to implement canvases. *************** *** 642,653 **** --- 645,663 ---- */ int + #ifdef KANJI + Tk_CanvasPsFont(interp, canvas, fontStructPtr, fontTypeName) + #else Tk_CanvasPsFont(interp, canvas, fontStructPtr) + #endif /* KANJI */ Tcl_Interp *interp; /* Interpreter for returning Postscript * or error message. */ Tk_Canvas canvas; /* Information about canvas. */ XFontStruct *fontStructPtr; /* Information about font in which text * is to be printed. */ + #ifdef KANJI + char *fontTypeName; /* Character set type of the font. */ + #endif /* KANJI */ { TkCanvas *canvasPtr = (TkCanvas *) canvas; TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr; *************** *** 694,711 **** --- 704,752 ---- goto badMapEntry; } sprintf(pointString, "%.15g", size); + #ifdef KANJI + Tcl_AppendResult(interp, "/", fontTypeName, + " /", argv[0], " findfont ", + pointString, " scalefont ", (char *) NULL); + #else Tcl_AppendResult(interp, "/", argv[0], " findfont ", pointString, " scalefont ", (char *) NULL); + #endif /* KANJI */ if (strncasecmp(argv[0], "Symbol", 7) != 0) { Tcl_AppendResult(interp, "ISOEncode ", (char *) NULL); } + #ifdef KANJI + Tcl_AppendResult(interp, "def\n", (char *) NULL); + #else Tcl_AppendResult(interp, "setfont\n", (char *) NULL); + #endif /* KANJI */ Tcl_CreateHashEntry(&psInfoPtr->fontTable, argv[0], &i); ckfree((char *) argv); return TCL_OK; } } + #ifdef KANJI + /* + * Kanji fonts are often specified by non-XLFD names. + * If the name is not an XLFD conforming one, get XLFD name. + */ + if (name[0] != '-') { + #if defined(__WIN32__) + if (!strcmp(name, "a14")) { + name = "-*-Times-Medium-R-*--*-140-*-*-*-*-*-*"; + } else if (!strcmp(name, "k14")) { + name = "-*-Dummy-Medium-R-*--*-140-*-*-*-*-*-*"; + } + #else + unsigned long fontatom; + if (XGetFontProperty(fontStructPtr, XA_FONT, &fontatom)) { + name = Tk_GetAtomName(canvasPtr->tkwin, (Atom)fontatom); + } + #endif /* __WIN32__ */ + } + #endif /* KANJI */ + /* * Not in the font map. Try to parse the name to get four fields: * family name, weight, slant, and point size. To do this, split the *************** *** 727,732 **** --- 768,778 ---- p++; } + #ifdef KANJI + if (!strcmp(fontTypeName, "kanjifont")) { + strcpy(fontName, DEF_CANVAS_PS_KANJI_FONT); + } else { + #endif /* KANJI */ /* * Use the information from the X font name to make a guess at a * Postscript font name of the form "-" where *************** *** 785,801 **** --- 831,882 ---- if ((weightString[0] != 0) || (slantString[0] != 0)) { sprintf(p, "-%s%s", weightString, slantString); } + #ifdef KANJI + } + #endif /* KANJI */ points = strtoul(fieldPtrs[SIZE_FIELD], &end, 0); + #ifdef KANJI + /* + * Kanji fonts are often specified without point-size. + * if the size field is '*', calculate it from other parameters. + */ + if (points == 0 && fieldPtrs[SIZE_FIELD][0] == '*') { + Tk_Window tkwin = canvasPtr->tkwin; + Atom psizeatom = Tk_InternAtom(tkwin, "POINT_SIZE"); + Atom resxatom = Tk_InternAtom(tkwin, "RESOLUTION_X"); + unsigned long psize, resx; + if (XGetFontProperty(fontStructPtr, psizeatom, &psize) && + XGetFontProperty(fontStructPtr, resxatom, &resx)) { + Display *dpy = Tk_Display(tkwin); + int scr = Tk_ScreenNumber(tkwin); + int width = DisplayWidth(dpy, scr); + int widthmm = DisplayWidthMM(dpy, scr); + int actualresx = (width * 25.4) / widthmm; + + points = (psize * resx) / actualresx; + } + } + #endif /* KANJI */ if (points == 0) { goto error; } sprintf(pointString, "%.15g", ((double) points)/10.0); + #ifdef KANJI + Tcl_AppendResult(interp, "/", fontTypeName, + " /", fontName, " findfont ", + pointString, " scalefont ", (char *) NULL); + #else Tcl_AppendResult(interp, "/", fontName, " findfont ", pointString, " scalefont ", (char *) NULL); + #endif /* KANJI */ if (strcmp(fontName, "Symbol") != 0) { Tcl_AppendResult(interp, "ISOEncode ", (char *) NULL); } + #ifdef KANJI + Tcl_AppendResult(interp, "def\n", (char *) NULL); + #else Tcl_AppendResult(interp, "setfont\n", (char *) NULL); + #endif /* KANJI */ Tcl_CreateHashEntry(&psInfoPtr->fontTable, fontName, &i); return TCL_OK; diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/generic/tkCanvText.c ./generic/tkCanvText.c *** ../tk4.2/generic/tkCanvText.c Tue Aug 27 02:09:10 1996 --- ./generic/tkCanvText.c Fri Oct 18 13:14:45 1996 *************** *** 24,32 **** --- 24,36 ---- */ typedef struct TextLine { + #ifdef KANJI + wchar *firstChar; + #else char *firstChar; /* Pointer to the first character in this * line (in the "text" field of enclosing * text item). */ + #endif /* KANJI */ int numChars; /* Number of characters displayed in this * line. */ int totalChars; /* Total number of characters included as *************** *** 44,49 **** --- 48,58 ---- * pixel units). */ } TextLine; + #ifdef KANJI + #define TkMeasureChars TkMeasureWChars + #define TkDisplayChars TkDisplayWChars + #endif /* KANJI */ + /* * The structure below defines the record for each text item. */ *************** *** 57,63 **** --- 66,76 ---- * insertion cursor. The structure is owned * by (and shared with) the generic canvas * code. */ + #ifdef KANJI + wchar *text; + #else char *text; /* Text for item (malloc-ed). */ + #endif /* KANJI */ int numChars; /* Number of non-NULL characters in text. */ double x, y; /* Positioning point for text. */ Tk_Anchor anchor; /* Where to anchor text relative to (x,y). */ *************** *** 67,76 **** --- 80,99 ---- int rightEdge; /* Pixel just to right of right edge of * area of text item. Used for selecting * up to end of line. */ + #ifdef KANJI + XWSFontSet *fontPtr; + XFontStruct *asciiFontPtr; + XFontStruct *kanjiFontPtr; + #else XFontStruct *fontPtr; /* Font for drawing text. */ + #endif /* KANJI */ XColor *color; /* Color for text. */ Pixmap stipple; /* Stipple bitmap for text, or None. */ + #ifdef KANJI + XWSGC gc; + #else GC gc; /* Graphics context for drawing text. */ + #endif /* KANJI */ TextLine *linePtr; /* Pointer to array of structures describing * individual lines of text item (malloc-ed). */ int numLines; /* Number of structs at *linePtr. */ *************** *** 80,86 **** --- 103,113 ---- * to use to draw the insertion cursor when * it's off. Usedif the selection and * insertion cursor colors are the same. */ + #ifdef KANJI + XWSGC selTextGC; + #else GC selTextGC; /* Graphics context for selected text. */ + #endif /* KANJI */ } TextItem; /* *************** *** 97,105 **** --- 124,139 ---- TK_CONFIG_DONT_SET_DEFAULT}, {TK_CONFIG_COLOR, "-fill", (char *) NULL, (char *) NULL, "black", Tk_Offset(TextItem, color), 0}, + #ifdef KANJI + {TK_CONFIG_FONT, "-font", (char *) NULL, (char *) NULL, + "a14", Tk_Offset(TextItem, asciiFontPtr), 0}, + {TK_CONFIG_FONT, "-kanjifont", (char *) NULL, (char *) NULL, + "k14", Tk_Offset(TextItem, kanjiFontPtr), 0}, + #else {TK_CONFIG_FONT, "-font", (char *) NULL, (char *) NULL, "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*", Tk_Offset(TextItem, fontPtr), 0}, + #endif /* KANJI */ {TK_CONFIG_JUSTIFY, "-justify", (char *) NULL, (char *) NULL, "left", Tk_Offset(TextItem, justify), TK_CONFIG_DONT_SET_DEFAULT}, *************** *** 107,114 **** --- 141,153 ---- (char *) NULL, Tk_Offset(TextItem, stipple), TK_CONFIG_NULL_OK}, {TK_CONFIG_CUSTOM, "-tags", (char *) NULL, (char *) NULL, (char *) NULL, 0, TK_CONFIG_NULL_OK, &tagsOption}, + #ifdef KANJI + {TK_CONFIG_WSTRING, "-text", (char *) NULL, (char *) NULL, + "", Tk_Offset(TextItem, text), 0}, + #else {TK_CONFIG_STRING, "-text", (char *) NULL, (char *) NULL, "", Tk_Offset(TextItem, text), 0}, + #endif /* KANJI */ {TK_CONFIG_PIXELS, "-width", (char *) NULL, (char *) NULL, "0", Tk_Offset(TextItem, width), TK_CONFIG_DONT_SET_DEFAULT}, {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL, *************** *** 138,145 **** --- 177,189 ---- static int GetTextIndex _ANSI_ARGS_((Tcl_Interp *interp, Tk_Canvas canvas, Tk_Item *itemPtr, char *indexString, int *indexPtr)); + #ifdef KANJI + static void LineToPostscript _ANSI_ARGS_((Tcl_Interp *interp, + wchar *string, int numChars)); + #else static void LineToPostscript _ANSI_ARGS_((Tcl_Interp *interp, char *string, int numChars)); + #endif /* KANJI */ static void ScaleText _ANSI_ARGS_((Tk_Canvas canvas, Tk_Item *itemPtr, double originX, double originY, double scaleX, double scaleY)); *************** *** 240,253 **** --- 284,309 ---- textPtr->justify = TK_JUSTIFY_LEFT; textPtr->rightEdge = 0; textPtr->fontPtr = NULL; + #ifdef KANJI + textPtr->asciiFontPtr = NULL; + textPtr->kanjiFontPtr = NULL; + #endif /* KANJI */ textPtr->color = NULL; textPtr->stipple = None; + #ifdef KANJI + textPtr->gc = NULL; + #else textPtr->gc = None; + #endif /* KANJI */ textPtr->linePtr = NULL; textPtr->numLines = 0; textPtr->insertPos = 0; textPtr->cursorOffGC = None; + #ifdef KANJI + textPtr->selTextGC = NULL; + #else textPtr->selTextGC = None; + #endif /* KANJI */ /* * Process the arguments to fill in the item record. *************** *** 347,353 **** --- 403,414 ---- { TextItem *textPtr = (TextItem *) itemPtr; XGCValues gcValues; + #ifdef KANJI + XWSGC newGCSet, newSelGCSet; + GC newGC; + #else GC newGC, newSelGC; + #endif /* KANJI */ unsigned long mask; Tk_Window tkwin; Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr; *************** *** 364,384 **** --- 425,469 ---- * graphics contexts. */ + #ifdef KANJI + textPtr->fontPtr = Tk_GetFontSet(textPtr->asciiFontPtr, textPtr->kanjiFontPtr); + textPtr->numChars = Tcl_WStrlen(textPtr->text); + newGCSet = newSelGCSet = NULL; + #else textPtr->numChars = strlen(textPtr->text); newGC = newSelGC = None; + #endif /* KANJI */ if ((textPtr->color != NULL) && (textPtr->fontPtr != NULL)) { gcValues.foreground = textPtr->color->pixel; + #ifndef KANJI gcValues.font = textPtr->fontPtr->fid; + #endif /* KANJI */ mask = GCForeground|GCFont; if (textPtr->stipple != None) { gcValues.stipple = textPtr->stipple; gcValues.fill_style = FillStippled; mask |= GCForeground|GCStipple|GCFillStyle; } + #ifdef KANJI + newGCSet = Tk_GetGCSet(tkwin, mask, &gcValues, textPtr->fontPtr); + gcValues.foreground = textInfoPtr->selFgColorPtr->pixel; + newSelGCSet = Tk_GetGCSet(tkwin, mask, &gcValues, textPtr->fontPtr); + #else newGC = Tk_GetGC(tkwin, mask, &gcValues); gcValues.foreground = textInfoPtr->selFgColorPtr->pixel; newSelGC = Tk_GetGC(tkwin, mask, &gcValues); + #endif /* KANJI */ + } + #ifdef KANJI + if (textPtr->gc != NULL) { + Tk_FreeGCSet(Tk_Display(tkwin), textPtr->gc); + } + textPtr->gc = newGCSet; + if (textPtr->selTextGC != NULL) { + Tk_FreeGCSet(Tk_Display(tkwin), textPtr->selTextGC); } + textPtr->selTextGC = newSelGCSet; + #else if (textPtr->gc != None) { Tk_FreeGC(Tk_Display(tkwin), textPtr->gc); } *************** *** 387,392 **** --- 472,478 ---- Tk_FreeGC(Tk_Display(tkwin), textPtr->selTextGC); } textPtr->selTextGC = newSelGC; + #endif /* KANJI */ selBgColorPtr = Tk_3DBorderColor(textInfoPtr->selBorder); if (Tk_3DBorderColor(textInfoPtr->insertBorder)->pixel *************** *** 458,486 **** --- 544,600 ---- TextItem *textPtr = (TextItem *) itemPtr; if (textPtr->text != NULL) { + #ifdef KANJI + Tk_FreeWStr(textPtr->text); + #else ckfree(textPtr->text); + #endif /* KANJI */ + } + #ifdef KANJI + if (textPtr->fontPtr != NULL) { + Tk_FreeFontSet(textPtr->fontPtr); } + if (textPtr->asciiFontPtr != NULL) { + Tk_FreeFontStruct(textPtr->asciiFontPtr); + } + if (textPtr->kanjiFontPtr != NULL) { + Tk_FreeFontStruct(textPtr->kanjiFontPtr); + } + #else if (textPtr->fontPtr != NULL) { Tk_FreeFontStruct(textPtr->fontPtr); } + #endif /* KANJI */ if (textPtr->color != NULL) { Tk_FreeColor(textPtr->color); } if (textPtr->stipple != None) { Tk_FreeBitmap(display, textPtr->stipple); } + #ifdef KANJI + if (textPtr->gc != NULL) { + Tk_FreeGCSet(display, textPtr->gc); + } + #else if (textPtr->gc != None) { Tk_FreeGC(display, textPtr->gc); } + #endif /* KANJI */ if (textPtr->linePtr != NULL) { ckfree((char *) textPtr->linePtr); } if (textPtr->cursorOffGC != None) { Tk_FreeGC(display, textPtr->cursorOffGC); } + #ifdef KANJI + if (textPtr->selTextGC != NULL) { + Tk_FreeGCSet(display, textPtr->selTextGC); + } + #else if (textPtr->selTextGC != None) { Tk_FreeGC(display, textPtr->selTextGC); } + #endif /* KANJI */ } /* *************** *** 512,523 **** --- 626,645 ---- { TextLine *linePtr; #define MAX_LINES 100 + #ifdef KANJI + wchar *lineStart[MAX_LINES]; + #else char *lineStart[MAX_LINES]; + #endif /* KANJI */ int lineChars[MAX_LINES]; int linePixels[MAX_LINES]; int numLines, wrapPixels, maxLinePixels, leftX, topY, y; int lineHeight, i, fudge; + #ifdef KANJI + wchar *p; + #else char *p; + #endif /* KANJI */ XCharStruct *maxBoundsPtr = &textPtr->fontPtr->max_bounds; Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr; *************** *** 558,564 **** --- 680,690 ---- * displayed when it is in the middle of a multi-space. */ + #ifdef KANJI + if (ISWSPACE(*p)) { + #else if (isspace(UCHAR(*p))) { + #endif /* KANJI */ p++; } else if (*p == 0) { /* *************** *** 725,731 **** --- 851,861 ---- Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr; Tk_Window tkwin = Tk_CanvasTkwin(canvas); + #ifdef KANJI + if (textPtr->gc == NULL) { + #else if (textPtr->gc == None) { + #endif /* KANJI */ return; } *************** *** 736,742 **** --- 866,876 ---- */ if (textPtr->stipple != None) { + #ifdef KANJI + Tk_CanvasSetStippleOrigin(canvas, textPtr->gc->fe[0].gc); + #else Tk_CanvasSetStippleOrigin(canvas, textPtr->gc); + #endif /* KANJI */ } focusHere = (textInfoPtr->focusItemPtr == itemPtr) && *************** *** 876,882 **** --- 1010,1021 ---- } } if (textPtr->stipple != None) { + #ifdef KANJI + XSetTSOrigin(display, textPtr->gc->fe[0].gc, 0, 0); + XSetTSOrigin(display, textPtr->gc->fe[1].gc, 0, 0); + #else XSetTSOrigin(display, textPtr->gc, 0, 0); + #endif /* KANJI */ } } *************** *** 908,917 **** --- 1047,1066 ---- { TextItem *textPtr = (TextItem *) itemPtr; int length; + #ifdef KANJI + TkCanvas *canvasPtr = (TkCanvas *) canvas; + wchar *wstr; + #else char *new; + #endif /* KANJI */ Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr; + #ifdef KANJI + wstr = Tk_GetWStr(canvasPtr->interp, string); + length = Tcl_WStrlen(wstr); + #else length = strlen(string); + #endif /* KANJI */ if (length == 0) { return; } *************** *** 922,933 **** --- 1071,1087 ---- beforeThis = textPtr->numChars; } + #ifdef KANJI + textPtr->text = Tk_InsertWStr(canvasPtr->interp, textPtr->text, beforeThis, wstr); + Tk_FreeWStr(wstr); + #else new = (char *) ckalloc((unsigned) (textPtr->numChars + length + 1)); strncpy(new, textPtr->text, (size_t) beforeThis); strcpy(new+beforeThis, string); strcpy(new+beforeThis+length, textPtr->text+beforeThis); ckfree(textPtr->text); textPtr->text = new; + #endif /* KANJI */ textPtr->numChars += length; /* *************** *** 980,986 **** --- 1134,1144 ---- { TextItem *textPtr = (TextItem *) itemPtr; int count; + #ifdef KANJI + TkCanvas *canvasPtr = (TkCanvas *) canvas; + #else char *new; + #endif /* KANJI */ Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr; if (first < 0) { *************** *** 994,1004 **** --- 1152,1166 ---- } count = last + 1 - first; + #ifdef KANJI + textPtr->text = Tk_DeleteWStr(canvasPtr->interp, textPtr->text, first, count); + #else new = (char *) ckalloc((unsigned) (textPtr->numChars + 1 - count)); strncpy(new, textPtr->text, (size_t) first); strcpy(new+first, textPtr->text+last+1); ckfree(textPtr->text); textPtr->text = new; + #endif /* KANJI */ textPtr->numChars -= count; /* *************** *** 1445,1463 **** --- 1607,1648 ---- TextItem *textPtr = (TextItem *) itemPtr; int count; Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr; + #ifdef KANJI + char *str; + count = textInfoPtr->selectLast + 1 - textInfoPtr->selectFirst; + if (textInfoPtr->selectLast == textPtr->numChars) { + count -= 1; + } + if (textInfoPtr->use_ctext) { + str = Tk_WStrToCtext(textPtr->text + textInfoPtr->selectFirst, count); + } else { + str = Tk_WStrToString(textPtr->text + textInfoPtr->selectFirst, count); + } + if (str == NULL) return 0; + count = strlen(str) - offset; + #else /* KANJI */ count = textInfoPtr->selectLast + 1 - textInfoPtr->selectFirst - offset; if (textInfoPtr->selectLast == textPtr->numChars) { count -= 1; } + #endif /* KANJI */ if (count > maxBytes) { count = maxBytes; } if (count <= 0) { + #ifdef KANJI + ckfree(str); + #endif /* KANJI */ return 0; } + #ifdef KANJI + strncpy(buffer, str + offset, (size_t) count); + ckfree(str); + #else strncpy(buffer, textPtr->text + textInfoPtr->selectFirst + offset, (size_t) count); + #endif /* KANJI */ buffer[count] = '\0'; return count; } *************** *** 1506,1514 **** --- 1691,1706 ---- return TCL_OK; } + #ifdef KANJI + if (Tk_CanvasPsFont(interp, canvas, textPtr->fontPtr->asciiFont, "asciifont") != TCL_OK || + Tk_CanvasPsFont(interp, canvas, textPtr->fontPtr->kanjiFont, "kanjifont") != TCL_OK) { + return TCL_ERROR; + } + #else if (Tk_CanvasPsFont(interp, canvas, textPtr->fontPtr) != TCL_OK) { return TCL_ERROR; } + #endif /* KANJI */ if (Tk_CanvasPsColor(interp, canvas, textPtr->color) != TCL_OK) { return TCL_ERROR; } *************** *** 1544,1550 **** --- 1736,1746 ---- case TK_JUSTIFY_CENTER: justify = "0.5"; break; case TK_JUSTIFY_RIGHT: justify = "1"; break; } + #ifdef KANJI + sprintf(buffer, "] %d %s %s %s %s MFDrawText\n", + #else sprintf(buffer, "] %d %s %s %s %s DrawText\n", + #endif /* KANJI */ textPtr->fontPtr->ascent + textPtr->fontPtr->descent, xoffset, yoffset, justify, (textPtr->stipple == None) ? "false" : "true"); *************** *** 1574,1586 **** --- 1770,1828 ---- static void LineToPostscript(interp, string, numChars) Tcl_Interp *interp; /* Interp whose result is to be appended to. */ + #ifdef KANJI + wchar *string; + #else char *string; /* String to Postscript-ify. */ + #endif /* KANJI */ int numChars; /* Number of characters in the string. */ { #define BUFFER_SIZE 100 + #ifdef KANJI + char buffer[BUFFER_SIZE+30]; + int lastgset = -1; + #else /* KANJI */ char buffer[BUFFER_SIZE+5]; + #endif /* KANJI */ int used, c; + #ifdef KANJI + strcpy(buffer, "[ <"); + used = 3; + for ( ; numChars > 0; string++, numChars--) { + c = *string; + switch (c & 0x8080) { + case 0: + if (lastgset == 1) { + strcpy(buffer + used, "> {kanjishow} <"); + used += strlen(buffer + used); + } + lastgset = 0; + break; + case 0x8080: + if (lastgset == 0) { + strcpy(buffer + used, "> {asciishow} <"); + used += strlen(buffer + used); + } + lastgset = 1; + break; + default: + continue; + } + c &= 0x7f7f; + sprintf(buffer+used, "%02x", c); + used += strlen(buffer+used); + if (used >= BUFFER_SIZE) { + buffer[used] = 0; + Tcl_AppendResult(interp, buffer, (char *) NULL); + used = 0; + } + } + buffer[used] = 0; + Tcl_AppendResult(interp, buffer, "> ", + (lastgset == 1) ? "{kanjishow}" : "{asciishow}", + " ]", (char *)NULL); + #else /* KANJI */ buffer[0] = '('; used = 1; for ( ; numChars > 0; string++, numChars--) { *************** *** 1608,1611 **** --- 1850,1854 ---- buffer[used] = ')'; buffer[used+1] = 0; Tcl_AppendResult(interp, buffer, (char *) NULL); + #endif /* KANJI */ } diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/generic/tkCanvas.c ./generic/tkCanvas.c *** ../tk4.2/generic/tkCanvas.c Tue Aug 27 02:09:13 1996 --- ./generic/tkCanvas.c Fri Oct 18 13:14:46 1996 *************** *** 179,184 **** --- 179,189 ---- static int CanvasFetchSelection _ANSI_ARGS_(( ClientData clientData, int offset, char *buffer, int maxBytes)); + #ifdef KANJI + static int CanvasFetchSelectionCtext _ANSI_ARGS_(( + ClientData clientData, int offset, + char *buffer, int maxBytes)); + #endif /* KANJI */ static Tk_Item * CanvasFindClosest _ANSI_ARGS_((TkCanvas *canvasPtr, double coords[2])); static void CanvasFocusProc _ANSI_ARGS_((TkCanvas *canvasPtr, *************** *** 344,349 **** --- 349,366 ---- Tk_CreateEventHandler(canvasPtr->tkwin, ExposureMask|StructureNotifyMask|FocusChangeMask, CanvasEventProc, (ClientData) canvasPtr); + #ifdef KANJI + { + Atom textatom = Tk_InternAtom(canvasPtr->tkwin, "TEXT"); + Atom ctextatom = Tk_InternAtom(canvasPtr->tkwin, "COMPOUND_TEXT"); + Tk_CreateSelHandler(canvasPtr->tkwin, XA_PRIMARY, textatom, + CanvasFetchSelectionCtext, + (ClientData) canvasPtr, ctextatom); + Tk_CreateSelHandler(canvasPtr->tkwin, XA_PRIMARY, ctextatom, + CanvasFetchSelectionCtext, + (ClientData) canvasPtr, ctextatom); + } + #endif /* KANJI */ Tk_CreateEventHandler(canvasPtr->tkwin, KeyPressMask|KeyReleaseMask |ButtonPressMask|ButtonReleaseMask|EnterWindowMask |LeaveWindowMask|PointerMotionMask, CanvasBindProc, *************** *** 3391,3400 **** --- 3408,3464 ---- if (canvasPtr->textInfo.selItemPtr->typePtr->selectionProc == NULL) { return -1; } + #ifdef KANJI + canvasPtr->textInfo.use_ctext = 0; + #endif /* KANJI */ + return (*canvasPtr->textInfo.selItemPtr->typePtr->selectionProc)( + (Tk_Canvas) canvasPtr, canvasPtr->textInfo.selItemPtr, offset, + buffer, maxBytes); + } + + #ifdef KANJI + /* + *-------------------------------------------------------------- + * + * CanvasFetchSelectionCtext -- + * + * This procedure is similar to CanvasFetchSelection + * except it use COMPOUND_TEXT encoding for the selection. + * + * Results: + * See CanvasFetchSelection. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + + static int + CanvasFetchSelectionCtext(clientData, offset, buffer, maxBytes) + ClientData clientData; /* Information about canvas widget. */ + int offset; /* Offset within selection of first + * character to be returned. */ + char *buffer; /* Location in which to place + * selection. */ + int maxBytes; /* Maximum number of bytes to place + * at buffer, not including terminating + * NULL character. */ + { + TkCanvas *canvasPtr = (TkCanvas *) clientData; + + if (canvasPtr->textInfo.selItemPtr == NULL) { + return -1; + } + if (canvasPtr->textInfo.selItemPtr->typePtr->selectionProc == NULL) { + return -1; + } + canvasPtr->textInfo.use_ctext = 1; return (*canvasPtr->textInfo.selItemPtr->typePtr->selectionProc)( (Tk_Canvas) canvasPtr, canvasPtr->textInfo.selItemPtr, offset, buffer, maxBytes); } + #endif /* KANJI */ /* *---------------------------------------------------------------------- diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/generic/tkClipboard.c ./generic/tkClipboard.c *** ../tk4.2/generic/tkClipboard.c Tue Aug 27 02:09:13 1996 --- ./generic/tkClipboard.c Fri Oct 18 13:14:46 1996 *************** *** 394,402 **** --- 394,423 ---- } targetPtr->lastBufferPtr = cbPtr; + #ifdef KANJI + if (type == Tk_InternAtom(tkwin, "COMPOUND_TEXT")) { + int kanjiCode = Tcl_KanjiCode(interp); + int count = Tcl_KanjiEncode(kanjiCode, (unsigned char *) buffer, NULL); + wchar *wstr = (wchar *) ckalloc(sizeof(wchar) * (unsigned) (count + 1)); + + (void) Tcl_KanjiEncode(kanjiCode, (unsigned char *) buffer, wstr); + cbPtr->buffer = Tk_WStrToCtext(wstr, -1); + if (cbPtr->buffer != NULL) { + cbPtr->length = strlen(cbPtr->buffer); + } else { + cbPtr->buffer = ckalloc(1); + cbPtr->buffer[0] = '\0'; + cbPtr->length = 0; + } + ckfree((char *) wstr); + } else { + #endif /* KANJI */ cbPtr->length = strlen(buffer); cbPtr->buffer = (char *) ckalloc((unsigned) (cbPtr->length + 1)); strcpy(cbPtr->buffer, buffer); + #ifdef KANJI + } + #endif /* KANJI */ TkSelUpdateClipboard((TkWindow*)(dispPtr->clipWindow), targetPtr); *************** *** 487,498 **** --- 508,527 ---- if (targetName != NULL) { target = Tk_InternAtom(tkwin, targetName); } else { + #ifdef KANJI + target = Tk_InternAtom(tkwin, "COMPOUND_TEXT"); + #else target = XA_STRING; + #endif /* KANJI */ } if (formatName != NULL) { format = Tk_InternAtom(tkwin, formatName); } else { + #ifdef KANJI + format = Tk_InternAtom(tkwin, "COMPOUND_TEXT"); + #else format = XA_STRING; + #endif /* KANJI */ } return Tk_ClipboardAppend(interp, tkwin, target, format, args[0]); } else if ((c == 'c') && (strncmp(argv[1], "clear", length) == 0)) { diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/generic/tkCmds.c ./generic/tkCmds.c *** ../tk4.2/generic/tkCmds.c Tue Aug 27 02:09:14 1996 --- ./generic/tkCmds.c Fri Oct 18 13:14:47 1996 *************** *** 418,423 **** --- 418,511 ---- return TCL_OK; } + #ifdef KANJI + /* + *---------------------------------------------------------------------- + * + * Tk_KanjiInputCmd -- + * + * This procedure is invoked to process the "kanjiInput" 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 + Tk_KanjiInputCmd(clientData, interp, argc, argv) + ClientData clientData; /* Main window associated with + * interpreter. */ + Tcl_Interp *interp; /* Current interpreter. */ + int argc; /* Number of arguments. */ + char **argv; /* Argument strings. */ + { + Tk_Window tkwin = (Tk_Window) clientData; + Tk_Window winPtr; + int length; + char c; + + if (argc < 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " option focusWindow ?arg arg ...?\"", (char *) NULL); + return TCL_ERROR; + } + winPtr = Tk_NameToWindow(interp, argv[2], tkwin); + if (winPtr == NULL ) { + return TCL_ERROR; + } + c = argv[1][0]; + length = strlen(argv[1]); + if ((c == 'a') && (strncmp(argv[1], "attribute", length) == 0)) { + #ifdef KINPUT2 + if (argc == 3) { + return Tk_Kinput2AttributeInfo(interp, winPtr, NULL); + } else if (argc == 4) { + return Tk_Kinput2AttributeInfo(interp, winPtr, argv[3]); + } else { + return Tk_Kinput2Attribute(interp, winPtr, argc-3, argv+3); + } + #else + Tcl_SetResult(interp, "no kanji conversion server supported", TCL_VOLATILE); + return TCL_ERROR; + #endif + } else if ((c == 's') && (strncmp(argv[1], "start", length) == 0)) { + #ifdef KINPUT2 + if (argc == 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " start focusWindow ?attributes ...?\"", (char *) NULL); + return TCL_ERROR; + } + return Tk_Kinput2Start(interp, winPtr, argc-3, argv+3); + #else + Tcl_SetResult(interp, "no kanji conversion server supported", TCL_VOLATILE); + return TCL_ERROR; + #endif + } else if ((c == 'e') && (strncmp(argv[1], "end", length) == 0)) { + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " end focusWindow\"", (char *) NULL); + return TCL_ERROR; + } + #ifdef KINPUT2 + return Tk_Kinput2End(interp, winPtr); + #else + Tcl_SetResult(interp, "no kanji conversion server supported", TCL_VOLATILE); + return TCL_ERROR; + #endif + } else { + Tcl_AppendResult(interp, "bad option \"", argv[1], + "\": must be start, end, or attribute", (char *) NULL); + return TCL_ERROR; + } + } + #endif /* KANJI */ + /* *---------------------------------------------------------------------- * diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/generic/tkConfig.c ./generic/tkConfig.c *** ../tk4.2/generic/tkConfig.c Tue Aug 27 02:09:36 1996 --- ./generic/tkConfig.c Fri Oct 18 13:14:47 1996 *************** *** 374,379 **** --- 374,396 ---- *((char **) ptr) = new; break; } + #ifdef KANJI + case TK_CONFIG_WSTRING: { + wchar *old, *new; + + if (nullValue) { + new = NULL; + } else { + new = Tk_GetWStr(interp, value); + } + old = *((wchar **) ptr); + if (old != NULL) { + Tk_FreeWStr(old); + } + *((wchar **) ptr) = new; + break; + } + #endif /* KANJI */ case TK_CONFIG_UID: if (nullValue) { *((Tk_Uid *) ptr) = NULL; *************** *** 753,758 **** --- 770,778 ---- * if result is static. */ { char *ptr, *result; + #ifdef KANJI + wchar *ws; + #endif /* KANJI */ *freeProcPtr = NULL; ptr = widgRec + specPtr->offset; *************** *** 779,784 **** --- 799,812 ---- result = ""; } break; + #ifdef KANJI + case TK_CONFIG_WSTRING: + ws = (*(wchar **) ptr); + if (ws != NULL) { + result = Tk_DecodeWStr(ws); + } + break; + #endif /* KANJI */ case TK_CONFIG_UID: { Tk_Uid uid = *((Tk_Uid *) ptr); if (uid != NULL) { *************** *** 961,966 **** --- 989,1002 ---- *((char **) ptr) = NULL; } break; + #ifdef KANJI + case TK_CONFIG_WSTRING: + if (*((wchar **) ptr) != NULL) { + Tk_FreeWStr(*((wchar **) ptr)); + *((wchar **) ptr) = NULL; + } + break; + #endif /* KANJI */ case TK_CONFIG_COLOR: if (*((XColor **) ptr) != NULL) { Tk_FreeColor(*((XColor **) ptr)); diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/generic/tkCtext.c ./generic/tkCtext.c *** ../tk4.2/generic/tkCtext.c Thu Jan 1 09:00:00 1970 --- ./generic/tkCtext.c Fri Oct 18 13:14:48 1996 *************** *** 0 **** --- 1,500 ---- + /* + * tkCtext.c -- + * + * This file contains conversion functions between + * wchar and STRING/COMPOUND_TEXT encoding. + * + * Copyright 1988,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. + */ + + #ifndef lint + static char rcsid[] = "$Header: /ext/cvsroot/tk/generic/tkCtext.c,v 1.1 1995/12/21 08:31:02 hoshi Exp $"; + #endif + + #ifdef KANJI + + #include "tkPort.h" + #include "tkInt.h" + + /* + * Character set flags. Each character set is specified + * with its Final Character and these flags. + * + * CS96 - indicates that the character set is 96 charset. + * otherwise 94. + * MBCS - indicates that the character set is a multibyte + * charset. + */ + #define CS96 0x100 + #define MBCS 0x200 + + static int convJWStoCT _ANSI_ARGS_((wchar *wstr, int len, + unsigned char *xstr)); + static int convCTtoJWS _ANSI_ARGS_((unsigned char *xstr, int len, + wchar *wstr)); + static unsigned char *getesc _ANSI_ARGS_((unsigned char *str, int len)); + static unsigned char *getcsi _ANSI_ARGS_((unsigned char *str, int len)); + + /* + *-------------------------------------------------------------- + * + * Tk_WStrToString -- + * + * Convert wchar string to STRING encoding string. + * Any characters which cannot be converted are ignored. + * + * Results: + * The return value is a pointer to the converted string, + * or NULL if an error occurred in the conversion process. + * The storage for the converted string is allocated with + * malloc (ckalloc, precisely), and it is the caller's + * responsibility to free it. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + + char * + Tk_WStrToString(ws, n) + wchar *ws; + int n; + { + int len; + char *s; + int i, j; + + /* if n < 0, count number of characters */ + if (n < 0) { + wchar *t = ws; + n = 0; + while (*t++ != 0) n++; + } + + /* calculate the length of the converted string */ + for (i = 0, len = 0; i < n; i++) { + if ((ws[i] & 0x8080) == 0) len++; /* G0 i.e. ASCII */ + } + + if (len <= 0) return NULL; + s = ckalloc((unsigned int)len + 1); + + /* do the conversion */ + for (i = 0, j = 0; i < n; i++) { + if ((ws[i] & 0x8080) == 0) s[j++] = ws[i] & 0x7f; + } + s[j] = '\0'; + + return s; + } + + /* + *-------------------------------------------------------------- + * + * Tk_WStrToCtext -- + * + * Convert wchar string to Compound Text string. + * + * Results: + * The return value is a pointer to the converted string, + * or NULL if an error occurred in the conversion process. + * The storage for the converted string is allocated with + * malloc (ckalloc, precisely), and it is the caller's + * responsibility to free it. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + + char * + Tk_WStrToCtext(ws, n) + wchar *ws; + int n; + { + int len; + char *ct; + + len = convJWStoCT(ws, n, (unsigned char *)NULL); + if (len <= 0) return NULL; + ct = ckalloc((unsigned int)len + 1); + (void)convJWStoCT(ws, n, (unsigned char *)ct); + return ct; + } + + /* + *-------------------------------------------------------------- + * + * Tk_CtextToWStr -- + * + * Convert Compound Text string to wchar string. Any + * characters which cannot be converted are ignored. + * Note that this function can be used to convert STRING + * to wchar string, for Compound Text is a superset of + * STRING. + * + * Results: + * The return value is a pointer to the converted string, + * or NULL if an error occurred in the conversion process. + * The storage for the converted string is allocated with + * malloc (ckalloc, precisely), and it is the caller's + * responsibility to free it. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + + wchar * + Tk_CtextToWStr(ct, n) + char *ct; + int n; + { + int len; + wchar *ws; + + len = convCTtoJWS((unsigned char *)ct, n, (wchar *)NULL); + if (len <= 0) return (wchar *)NULL; + ws = (wchar *)ckalloc(sizeof(wchar) * (unsigned int)(len + 1)); + len = convCTtoJWS((unsigned char *)ct, n, ws); + return ws; + } + + /* + *-------------------------------------------------------------- + * + * convJWStoCT -- + * + * Convert Japanese wide character string (type wchar) to + * Compound Text string and returns its length. + * + * Results: + * The return value is the length of the converted string + * (excluding trailing NUL byte). + * The converted string is written in the area specified + * by xstr. It is the caller's responsibility to allocate + * appropriate size of memory for xstr. + * If xstr is NULL, the converted string is not written, + * only the length of the string is returned. So calling + * with xstr NULL is useful for determining the size of + * required storage. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + + static int + convJWStoCT(wstr, len, xstr) + wchar *wstr; + int len; + unsigned char *xstr; + { + int g1; + int n = 0; + + /* + * G0, G1 usage: + * G0: ASCII + * G1: Kanji or Kana + */ + + /* COMPOUND_TEXT initial value -- ISO8859-1 */ + g1 = CS96|'A'; + + if (len < 0) { + wchar *t = wstr; + len = 0; + while (*t++ != 0) len++; + } + + while (len-- > 0) { + int c = *wstr++; + + switch (c & 0x8080) { + case 0: /* ASCII or C0 or DEL */ + if (c < ' ' || c == 0x7f) { + /* C0 or DEL */ + if (c == '\t' || c == '\n') { + if (xstr) *xstr++ = c; + n++; + } + break; + } + if (xstr) *xstr++ = c & 0x7f; + n++; + break; + case 0x80: /* Kana (JIS-X0201 right half) or C1 */ + if (c < 0xa0 || 0xfe < c) break; + if (g1 != 'I') { + if (xstr) { + *xstr++ = '\033'; + *xstr++ = ')'; + *xstr++ = 'I'; + } + n += 3; + g1 = 'I'; + } + if (xstr) *xstr++ = c & 0xff; + n++; + break; + case 0x8080: /* Kanji (JIS-X0208) */ + if (g1 != (MBCS|'B')) { + if (xstr) { + *xstr++ = '\033'; + *xstr++ = '$'; + *xstr++ = ')'; + *xstr++ = 'B'; + } + n += 4; + g1 = MBCS|'B'; + } + if (xstr) { + *xstr++ = (c >> 8) & 0xff; + *xstr++ = c & 0xff; + } + n += 2; + break; + default: + /* ignore G3 characters (undefined) */ + break; + } + } + + /* + * reset G1 to the default character set + */ + if (g1 != (CS96|'A')) { + if (xstr) { + *xstr++ = '\033'; + *xstr++ = '-'; + *xstr++ = 'A'; + } + n += 3; + } + + if (xstr) *xstr = '\0'; + return n; + } + + /* getesc -- get escape sequence */ + static unsigned char * + getesc(str, len) + unsigned char *str; + int len; + { + int c; + + /* skip intermediate characters: 02/00 - 02/15 */ + while (len > 0) { + c = *str; + if (c < 0x20 || 0x2f < c) break; + len--, str++; + } + /* check final character: 03/00 - 07/14 */ + if (--len < 0 || (c = *str++) < 0x30 || 0x7e < c) { + return (unsigned char *)NULL; + } + return str; + } + + /* getcsi -- get CSI sequence */ + static unsigned char * + getcsi(str, len) + unsigned char *str; + int len; + { + int c; + + /* skip parameter characters: 03/00 - 03/15 */ + while (len > 0) { + c = *str; + if (c < 0x30 || 0x3f < c) break; + len--, str++; + } + /* skip intermediate characters: 02/00 - 02/15 */ + while (len > 0) { + c = *str; + if (c < 0x20 || 0x2f < c) break; + len--, str++; + } + /* check final character: 04/00 - 07/14 */ + if (--len < 0 || (c = *str++) < 0x40 || 0x7e < c) { + return (unsigned char *)NULL; + } + return str; + } + + /* + *-------------------------------------------------------------- + * + * convCTtoJWS -- + * + * Convert Compound Text string to Japanese wide character + * string (type wchar) and returns its length. + * + * Results: + * The return value is the length (the number of characters) + * of the converted string (excluding trailing NUL character). + * The converted string is written in the area specified + * by wstr. It is the caller's responsibility to allocate + * appropriate size of memory for it. + * If wstr is NULL, the converted string is not written, + * only the length of the string is returned. So calling + * with wstr NULL is useful for determining the size of + * required storage. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + + static int + convCTtoJWS(xstr, len, wstr) + unsigned char *xstr; + int len; + wchar *wstr; + { + int c; + int nskip; + int n = 0; + int g0, g1, gs; + unsigned char *xstr1; + + if (len < 0) len = strlen((char *)xstr); + + /* + * set initial state: + * G0(GL): ASCII + * G1(GR): ISO8859-1 right half + */ + g0 = 'B'; + g1 = CS96|'A'; + + while (len-- > 0) { + switch (c = *xstr++) { + case '\n': case '\t': case ' ': /* NL, TAB, SPACE */ + if (wstr) *wstr++ = c; + n++; + break; + case 0x9b: /* CSI */ + /* + * CSI sequence: in the form of CSI {P} {I} F + * where + * parameter P: 03/00 - 03/15 + * intermediate char I: 02/00 - 02/15 + * final char F: 04/00 - 07/14 + * + * currently, only directionality is defined by + * the Compound Text standard. since Japanese + * doesn't need directionality to be specified, + * ignore all the CSI sequences. + */ + xstr1 = getcsi(xstr, len); + if (xstr1 == NULL) return -1; /* Error */ + len -= xstr1 - xstr; + xstr = xstr1; + break; + case '\033': /* ESC */ + /* + * escape sequence: in the form of ESC {I} F + * where + * intermediate char I: 02/00 - 02/15 + * final char F: 03/00 - 07/14 + * + * currently follwing sequences are defined. + * + statndard character set + * ESC-(-F ESC-)-F ESC---F -- single byte + * ESC-$-(-F ESC-$-)-F -- multi-byte + * + non-standard character set + * ESC-%-/-[0123] + */ + xstr1 = getesc(xstr, len); + if (xstr1 == NULL) return -1; /* Error */ + len -= xstr1 - xstr; + switch (xstr1 - xstr) { + case 2: /* ESC - I - F */ + switch (*xstr++) { + case '(': g0 = *xstr; break; /* 94 CS -> G0 */ + case ')': g1 = *xstr; break; /* 94 CS -> G1 */ + case '-': g1 = *xstr|CS96; break; /* 96 CS -> G1 */ + } + break; + case 3: /* ESC - I - I - F */ + switch (*xstr++) { + case '$': /* Muliti-Byte Character Set */ + switch (*xstr++) { + case '(': g0 = *xstr|MBCS; break; /* 94 MBCS -> G0 */ + case ')': g1 = *xstr|MBCS; break; /* 94 MBCS -> G1 */ + case '-': g1 = *xstr|CS96|MBCS; break; /* 96 MBCS -> G1 */ + } + break; + case '%': + if (*xstr++ != '/') break; /* unknown sequence */ + /* private encoding. skip. */ + len -= 2; + if (len < 0) return -1; + nskip = (*xstr1 & 0x7f) * 128 + (*(xstr1 + 1) & 0x7f); + if ((len -= nskip) < 0) return -1; + xstr1 += nskip + 2; + break; + } + break; + } + xstr = xstr1; + break; + default: + if (!(c & 0x60)) return -1; /* illegal C0 or C1 character */ + + gs = (c & 0x80) ? g1 : g0; + c &= 0x7f; + if (gs & MBCS) { + switch (gs & 0x70) { + case 0x70: /* 4byte/char */ + if (--len < 0) return -1; + c = (c << 8) | (*xstr++ & 0x7f); + case 0x60: /* 3byte/char */ + if (--len < 0) return -1; + c = (c << 8) | (*xstr++ & 0x7f); + case 0x50: /* 2byte/char */ + case 0x40: /* 2byte/char */ + if (--len < 0) return -1; + c = (c << 8) | (*xstr++ & 0x7f); + break; + default: + return -1; + } + } + if (gs == 'B' || gs == 'J' || gs == 'I' || gs == (MBCS|'B')) { + if (wstr) { + switch (gs) { + case MBCS|'B': *wstr++ = c | 0x8080; break; + case 'I': *wstr++ = c | 0x80; break; + default: *wstr++ = c; break; + } + } + n++; + } + break; + } + } + if (wstr) *wstr = 0; + return n; + } + + #endif /* KANJI */ diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/generic/tkEntry.c ./generic/tkEntry.c *** ../tk4.2/generic/tkEntry.c Tue Aug 27 05:27:13 1996 --- ./generic/tkEntry.c Fri Oct 18 13:14:48 1996 *************** *** 18,23 **** --- 18,28 ---- #include "tkPort.h" #include "tkInt.h" + #ifdef KANJI + #define TkMeasureChars TkMeasureWChars + #define TkDisplayChars TkDisplayWChars + #endif /* KANJI */ + /* * A data structure of the following type is kept for each entry * widget managed by this file: *************** *** 35,42 **** --- 40,51 ---- Tcl_Command widgetCmd; /* Token for entry's widget command. */ int numChars; /* Number of non-NULL characters in * string (may be 0). */ + #ifdef KANJI + wchar *string; + #else char *string; /* Pointer to storage for string; * NULL-terminated; malloc-ed. */ + #endif /* KANJI */ char *textVarName; /* Name of variable (malloc'ed) or NULL. * If non-NULL, entry's string tracks the * contents of this variable and vice versa. */ *************** *** 51,64 **** --- 60,87 ---- * window, plus used for background. */ int borderWidth; /* Width of 3-D border around window. */ int relief; /* 3-D effect: TK_RELIEF_RAISED, etc. */ + #ifdef KANJI + XWSFontSet *fontPtr; + XFontStruct *asciiFontPtr; + XFontStruct *kanjiFontPtr; + #else XFontStruct *fontPtr; /* Information about text font, or NULL. */ + #endif /* KANJI */ XColor *fgColorPtr; /* Text color in normal mode. */ + #ifdef KANJI + XWSGC textGC; + #else GC textGC; /* For drawing normal text. */ + #endif /* KANJI */ Tk_3DBorder selBorder; /* Border and background for selected * characters. */ int selBorderWidth; /* Width of border around selection. */ XColor *selFgColorPtr; /* Foreground color for selected text. */ + #ifdef KANJI + XWSGC selTextGC; + #else GC selTextGC; /* For drawing selected text. */ + #endif /* KANJI */ Tk_3DBorder insertBorder; /* Used to draw vertical bar for insertion * cursor. */ int insertWidth; /* Total width of insert cursor. */ *************** *** 93,104 **** --- 116,135 ---- int tabOrigin; /* Origin for tabs (left edge of string[0]). */ int insertPos; /* Index of character before which next * typed character will be inserted. */ + #ifdef KANJI + wchar *showChar; + #else char *showChar; /* Value of -show option. If non-NULL, first * character is used for displaying all * characters in entry. Malloc'ed. */ + #endif /* KANJI */ + #ifdef KANJI + wchar *displayString; + #else char *displayString; /* If non-NULL, points to string with same * length as string but whose characters * are all equal to showChar. Malloc'ed. */ + #endif /* KANJI */ /* * Information about what's selected, if any. *************** *** 193,200 **** --- 224,238 ---- Tk_Offset(Entry, exportSelection), 0}, {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL, (char *) NULL, 0, 0}, + #ifdef KANJI + {TK_CONFIG_FONT, "-font", "font", "Font", + DEF_ENTRY_FONT, Tk_Offset(Entry, asciiFontPtr), 0}, + {TK_CONFIG_FONT, "-kanjifont", "kanjiFont", "KanjiFont", + DEF_ENTRY_KANJIFONT, Tk_Offset(Entry, kanjiFontPtr), 0}, + #else {TK_CONFIG_FONT, "-font", "font", "Font", DEF_ENTRY_FONT, Tk_Offset(Entry, fontPtr), 0}, + #endif /* KANJI */ {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground", DEF_ENTRY_FG, Tk_Offset(Entry, fgColorPtr), 0}, {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground", *************** *** 241,248 **** --- 279,291 ---- {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background", DEF_ENTRY_SELECT_FG_MONO, Tk_Offset(Entry, selFgColorPtr), TK_CONFIG_MONO_ONLY}, + #ifdef KANJI + {TK_CONFIG_WSTRING, "-show", "show", "Show", + DEF_ENTRY_SHOW, Tk_Offset(Entry, showChar), TK_CONFIG_NULL_OK}, + #else {TK_CONFIG_STRING, "-show", "show", "Show", DEF_ENTRY_SHOW, Tk_Offset(Entry, showChar), TK_CONFIG_NULL_OK}, + #endif /* KANJI */ {TK_CONFIG_UID, "-state", "state", "State", DEF_ENTRY_STATE, Tk_Offset(Entry, state), 0}, {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus", *************** *** 287,292 **** --- 330,340 ---- int gotFocus)); static int EntryFetchSelection _ANSI_ARGS_((ClientData clientData, int offset, char *buffer, int maxBytes)); + #ifdef KANJI + static int EntryFetchSelectionCtext _ANSI_ARGS_(( + ClientData clientData, + int offset, char *buffer, int maxBytes)); + #endif /* KANJI */ static void EntryLostSelection _ANSI_ARGS_(( ClientData clientData)); static void EventuallyRedraw _ANSI_ARGS_((Entry *entryPtr)); *************** *** 304,309 **** --- 352,361 ---- double *firstPtr, double *lastPtr)); static int EntryWidgetCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int argc, char **argv)); + #ifdef KINPUT2 + static int EntryXYPos _ANSI_ARGS_((Tcl_Interp *interp, + Entry *entryPtr, int index)); + #endif static int GetEntryIndex _ANSI_ARGS_((Tcl_Interp *interp, Entry *entryPtr, char *string, int *indexPtr)); static void InsertChars _ANSI_ARGS_((Entry *entryPtr, int index, *************** *** 364,383 **** --- 416,451 ---- Tk_PathName(entryPtr->tkwin), EntryWidgetCmd, (ClientData) entryPtr, EntryCmdDeletedProc); entryPtr->numChars = 0; + #ifdef KANJI + entryPtr->string = Tk_GetWStr(interp, ""); + #else entryPtr->string = (char *) ckalloc(1); entryPtr->string[0] = '\0'; + #endif /* KANJI */ entryPtr->textVarName = NULL; entryPtr->state = tkNormalUid; entryPtr->normalBorder = NULL; entryPtr->borderWidth = 0; entryPtr->relief = TK_RELIEF_FLAT; entryPtr->fontPtr = NULL; + #ifdef KANJI + entryPtr->asciiFontPtr = NULL; + entryPtr->kanjiFontPtr = NULL; + #endif /* KANJI */ entryPtr->fgColorPtr = NULL; + #ifdef KANJI + entryPtr->textGC = NULL; + #else entryPtr->textGC = None; + #endif /* KANJI */ entryPtr->selBorder = NULL; entryPtr->selBorderWidth = 0; entryPtr->selFgColorPtr = NULL; + #ifdef KANJI + entryPtr->selTextGC = NULL; + #else entryPtr->selTextGC = None; + #endif /* KANJI */ entryPtr->insertBorder = NULL; entryPtr->insertWidth = 0; entryPtr->insertBorderWidth = 0; *************** *** 414,419 **** --- 482,499 ---- EntryEventProc, (ClientData) entryPtr); Tk_CreateSelHandler(entryPtr->tkwin, XA_PRIMARY, XA_STRING, EntryFetchSelection, (ClientData) entryPtr, XA_STRING); + #ifdef KANJI + { + Atom textatom = Tk_InternAtom(tkwin, "TEXT"); + Atom ctextatom = Tk_InternAtom(tkwin, "COMPOUND_TEXT"); + Tk_CreateSelHandler(entryPtr->tkwin, XA_PRIMARY, textatom, + EntryFetchSelectionCtext, + (ClientData) entryPtr, ctextatom); + Tk_CreateSelHandler(entryPtr->tkwin, XA_PRIMARY, ctextatom, + EntryFetchSelectionCtext, + (ClientData) entryPtr, ctextatom); + } + #endif /* KANJI */ if (ConfigureEntry(interp, entryPtr, argc-2, argv+2, 0) != TCL_OK) { goto error; } *************** *** 546,552 **** --- 626,636 ---- argv[0], " get\"", (char *) NULL); goto error; } + #ifdef KANJI + interp->result = Tk_DecodeWStr(entryPtr->string); + #else interp->result = entryPtr->string; + #endif /* KANJI */ } else if ((c == 'i') && (strncmp(argv[1], "icursor", length) == 0) && (length >= 2)) { if (argc != 3) { *************** *** 769,778 **** --- 853,881 ---- entryPtr->flags |= UPDATE_SCROLLBAR; EntryComputeGeometry(entryPtr); EventuallyRedraw(entryPtr); + #ifdef KINPUT2 + } else if ((c == 'x') && (strncmp(argv[1], "xypos", length) == 0)) { + int index; + + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " xypos index\"", + (char *) NULL); + goto error; + } + if (GetEntryIndex(interp, entryPtr, argv[2], &index) != TCL_OK || + EntryXYPos(interp, entryPtr, index) != TCL_OK) { + goto error; + } + #endif /* KINPUT2 */ } else { Tcl_AppendResult(interp, "bad option \"", argv[1], "\": must be bbox, cget, configure, delete, get, ", + #ifdef KINPUT2 + "icursor, index, insert, scan, selection, xview, or xypos", + #else "icursor, index, insert, scan, selection, or xview", + #endif /* KINPUT2 */ (char *) NULL); goto error; } *************** *** 815,835 **** --- 918,960 ---- * stuff. */ + #ifdef KANJI + Tk_FreeWStr(entryPtr->string); + #else ckfree(entryPtr->string); + #endif /* KANJI */ if (entryPtr->textVarName != NULL) { Tcl_UntraceVar(entryPtr->interp, entryPtr->textVarName, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, EntryTextVarProc, (ClientData) entryPtr); } + #ifdef KANJI + if (entryPtr->fontPtr != NULL ) { + Tk_FreeFontSet(entryPtr->fontPtr); + } + #endif /* KANJI */ + #ifdef KANJI + if (entryPtr->textGC != NULL) { + Tk_FreeGCSet(entryPtr->display, entryPtr->textGC); + } + if (entryPtr->selTextGC != NULL) { + Tk_FreeGCSet(entryPtr->display, entryPtr->selTextGC); + } + #else if (entryPtr->textGC != None) { Tk_FreeGC(entryPtr->display, entryPtr->textGC); } if (entryPtr->selTextGC != None) { Tk_FreeGC(entryPtr->display, entryPtr->selTextGC); } + #endif /* KANJI */ Tcl_DeleteTimerHandler(entryPtr->insertBlinkHandler); if (entryPtr->displayString != NULL) { + #ifdef KANJI + ckfree((char *) entryPtr->displayString); + #else ckfree(entryPtr->displayString); + #endif /* KANJI */ } Tk_FreeOptions(configSpecs, (char *) entryPtr, entryPtr->display, 0); ckfree((char *) entryPtr); *************** *** 866,871 **** --- 991,999 ---- int flags; /* Flags to pass to Tk_ConfigureWidget. */ { XGCValues gcValues; + #ifdef KANJI + XWSGC newGCSet; + #endif /* KANJI */ GC new; int oldExport; *************** *** 885,890 **** --- 1013,1022 ---- return TCL_ERROR; } + #ifdef KANJI + entryPtr->fontPtr = Tk_GetFontSet(entryPtr->asciiFontPtr, entryPtr->kanjiFontPtr); + #endif /* KANJI */ + /* * If the entry is tied to the value of a variable, then set up * a trace on the variable's value, create the variable if it doesn't *************** *** 920,925 **** --- 1052,1067 ---- Tk_SetBackgroundFromBorder(entryPtr->tkwin, entryPtr->normalBorder); + #ifdef KANJI + gcValues.foreground = entryPtr->fgColorPtr->pixel; + gcValues.graphics_exposures = False; + newGCSet = Tk_GetGCSet(entryPtr->tkwin, GCForeground|GCFont|GCGraphicsExposures, + &gcValues, entryPtr->fontPtr); + if (entryPtr->textGC != NULL) { + Tk_FreeGCSet(entryPtr->display, entryPtr->textGC); + } + entryPtr->textGC = newGCSet; + #else gcValues.foreground = entryPtr->fgColorPtr->pixel; gcValues.font = entryPtr->fontPtr->fid; gcValues.graphics_exposures = False; *************** *** 929,935 **** --- 1071,1087 ---- Tk_FreeGC(entryPtr->display, entryPtr->textGC); } entryPtr->textGC = new; + #endif /* KANJI */ + #ifdef KANJI + gcValues.foreground = entryPtr->selFgColorPtr->pixel; + newGCSet = Tk_GetGCSet(entryPtr->tkwin, GCForeground|GCFont, &gcValues, + entryPtr->fontPtr); + if (entryPtr->selTextGC != None) { + Tk_FreeGCSet(entryPtr->display, entryPtr->selTextGC); + } + entryPtr->selTextGC = newGCSet; + #else gcValues.foreground = entryPtr->selFgColorPtr->pixel; gcValues.font = entryPtr->fontPtr->fid; new = Tk_GetGC(entryPtr->tkwin, GCForeground|GCFont, &gcValues); *************** *** 937,942 **** --- 1089,1095 ---- Tk_FreeGC(entryPtr->display, entryPtr->selTextGC); } entryPtr->selTextGC = new; + #endif /* KANJI */ if (entryPtr->insertWidth <= 0) { entryPtr->insertWidth = 2; *************** *** 975,981 **** --- 1128,1138 ---- entryPtr->highlightWidth = 0; } entryPtr->inset = entryPtr->highlightWidth + entryPtr->borderWidth + XPAD; + #ifdef KANJI + entryPtr->avgWidth = XTextWidth(entryPtr->asciiFontPtr, "0", 1); + #else entryPtr->avgWidth = XTextWidth(entryPtr->fontPtr, "0", 1); + #endif /* KANJI */ EntryComputeGeometry(entryPtr); entryPtr->flags |= UPDATE_SCROLLBAR; EventuallyRedraw(entryPtr); *************** *** 1007,1013 **** --- 1164,1174 ---- int baseY, selStartX, selEndX, index, cursorX; int xBound, count; Pixmap pixmap; + #ifdef KANJI + wchar *displayString; + #else char *displayString; + #endif /* KANJI */ entryPtr->flags &= ~REDRAW_PENDING; if ((entryPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) { *************** *** 1187,1195 **** --- 1348,1363 ---- * and free up the pixmap. */ + #ifdef KANJI + XCopyArea(entryPtr->display, pixmap, Tk_WindowId(tkwin), + entryPtr->textGC->fe[0].gc, + 0, 0, (unsigned) Tk_Width(tkwin), (unsigned) Tk_Height(tkwin), + 0, 0); + #else XCopyArea(entryPtr->display, pixmap, Tk_WindowId(tkwin), entryPtr->textGC, 0, 0, (unsigned) Tk_Width(tkwin), (unsigned) Tk_Height(tkwin), 0, 0); + #endif /* KANJI */ Tk_FreePixmap(entryPtr->display, pixmap); entryPtr->flags &= ~BORDER_NEEDED; } *************** *** 1220,1226 **** --- 1388,1398 ---- { int totalLength, overflow, maxOffScreen, rightX; int fontHeight, height, width, i; + #ifdef KANJI + wchar *p, *displayString; + #else char *p, *displayString; + #endif /* KANJI */ /* * If we're displaying a special character instead of the value of *************** *** 1228,1239 **** --- 1400,1420 ---- */ if (entryPtr->displayString != NULL) { + #ifdef KANJI + ckfree((char *) entryPtr->displayString); + #else ckfree(entryPtr->displayString); + #endif /* KANJI */ entryPtr->displayString = NULL; } if (entryPtr->showChar != NULL) { + #ifdef KANJI + entryPtr->displayString = + (wchar *) ckalloc(sizeof(wchar) * (unsigned)(entryPtr->numChars + 1)); + #else entryPtr->displayString = (char *) ckalloc((unsigned) (entryPtr->numChars + 1)); + #endif /* KANJI */ for (p = entryPtr->displayString, i = entryPtr->numChars; i > 0; i--, p++) { *p = entryPtr->showChar[0]; *************** *** 1330,1335 **** --- 1511,1525 ---- * string). */ { int length; + #ifdef KANJI + wchar *wstr; + + wstr = Tk_GetWStr(entryPtr->interp, string); + length = Tcl_WStrlen(wstr); + if( length == 0 ) return; + entryPtr->string = Tk_InsertWStr(entryPtr->interp, entryPtr->string, index, wstr); + Tk_FreeWStr(wstr); + #else char *new; length = strlen(string); *************** *** 1342,1347 **** --- 1532,1538 ---- strcpy(new+index+length, entryPtr->string+index); ckfree(entryPtr->string); entryPtr->string = new; + #endif /* KANJI */ entryPtr->numChars += length; /* *************** *** 1393,1399 **** --- 1584,1592 ---- int index; /* Index of first character to delete. */ int count; /* How many characters to delete. */ { + #ifndef KANJI char *new; + #endif /* !KANJI */ if ((index + count) > entryPtr->numChars) { count = entryPtr->numChars - index; *************** *** 1402,1412 **** --- 1595,1609 ---- return; } + #ifdef KANJI + entryPtr->string = Tk_DeleteWStr(entryPtr->interp, entryPtr->string, index, count); + #else new = (char *) ckalloc((unsigned) (entryPtr->numChars + 1 - count)); strncpy(new, entryPtr->string, (size_t) index); strcpy(new+index, entryPtr->string+index+count); ckfree(entryPtr->string); entryPtr->string = new; + #endif /* KANJI */ entryPtr->numChars -= count; /* *************** *** 1480,1494 **** --- 1677,1702 ---- Entry *entryPtr; /* Entry whose value just changed. */ { char *newValue; + #ifdef KANJI + char *str = Tk_DecodeWStr(entryPtr->string); + #endif /* KANJI */ if (entryPtr->textVarName == NULL) { newValue = NULL; } else { newValue = Tcl_SetVar(entryPtr->interp, entryPtr->textVarName, + #ifdef KANJI + str, TCL_GLOBAL_ONLY); + #else entryPtr->string, TCL_GLOBAL_ONLY); + #endif /* KANJI */ } + #ifdef KANJI + if ((newValue != NULL) && (strcmp(newValue, str) != 0)) { + #else if ((newValue != NULL) && (strcmp(newValue, entryPtr->string) != 0)) { + #endif /* KANJI */ /* * The value of the variable is different than what we asked for. * This means that a trace on the variable modified it. In this *************** *** 1537,1546 **** --- 1745,1762 ---- * changed. */ char *value; /* New text to display in entry. */ { + #ifdef KANJI + wchar *old = entryPtr->string; + + entryPtr->string = Tk_GetWStr(entryPtr->interp, value); + entryPtr->numChars = Tcl_WStrlen(entryPtr->string); + Tk_FreeWStr(old); + #else ckfree(entryPtr->string); entryPtr->numChars = strlen(value); entryPtr->string = (char *) ckalloc((unsigned) (entryPtr->numChars + 1)); strcpy(entryPtr->string, value); + #endif /* KANJI */ if (entryPtr->selectFirst != -1) { if (entryPtr->selectFirst >= entryPtr->numChars) { entryPtr->selectFirst = entryPtr->selectLast = -1; *************** *** 1924,1941 **** --- 2140,2181 ---- { Entry *entryPtr = (Entry *) clientData; int count; + #ifdef KANJI + char *str; + wchar *displayString; + #else char *displayString; + #endif /* KANJI */ if ((entryPtr->selectFirst < 0) || !(entryPtr->exportSelection)) { return -1; } + #ifdef KANJI + if (entryPtr->displayString == NULL) { + displayString = entryPtr->string; + } else { + displayString = entryPtr->displayString; + } + count = entryPtr->selectLast - entryPtr->selectFirst; + str = Tk_WStrToString(displayString + entryPtr->selectFirst, count); + if (str == NULL) return 0; + count = strlen(str) - offset; + #else count = entryPtr->selectLast - entryPtr->selectFirst - offset; + #endif /* KANJI */ if (count > maxBytes) { count = maxBytes; } if (count <= 0) { + #ifdef KANJI + ckfree(str); + #endif /* KANJI */ return 0; } + #ifdef KANJI + strncpy(buffer, str + offset, (size_t) count); + ckfree(str); + #else if (entryPtr->displayString == NULL) { displayString = entryPtr->string; } else { *************** *** 1943,1951 **** --- 2183,2253 ---- } strncpy(buffer, displayString + entryPtr->selectFirst + offset, (size_t) count); + #endif /* KANJI */ + buffer[count] = '\0'; + return count; + } + + #ifdef KANJI + /* + *---------------------------------------------------------------------- + * + * EntryFetchSelectionCtext -- + * + * This procedure is same as EntryFetchSelection except it + * converts the selection data to compound text encoding. + * + * Results: + * See EntryFetchSelection. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + static int + EntryFetchSelectionCtext(clientData, offset, buffer, maxBytes) + ClientData clientData; /* Information about entry widget. */ + int offset; /* Offset within selection of first + * character to be returned. */ + char *buffer; /* Location in which to place + * selection. */ + int maxBytes; /* Maximum number of bytes to place + * at buffer, not including terminating + * NULL character. */ + { + Entry *entryPtr = (Entry *) clientData; + int count; + char *str; + wchar *displayString; + + if ((entryPtr->selectFirst < 0) || !(entryPtr->exportSelection)) { + return -1; + } + if (entryPtr->displayString == NULL) { + displayString = entryPtr->string; + } else { + displayString = entryPtr->displayString; + } + count = entryPtr->selectLast - entryPtr->selectFirst; + str = Tk_WStrToCtext(displayString + entryPtr->selectFirst, count); + if (str == NULL) return 0; + + count = strlen(str) - offset; + if (count > maxBytes) { + count = maxBytes; + } + if (count <= 0) { + ckfree(str); + return 0; + } + strncpy(buffer, str + offset, (size_t) count); + ckfree(str); buffer[count] = '\0'; return count; } + #endif /* KANJI */ /* *---------------------------------------------------------------------- *************** *** 2044,2050 **** --- 2346,2356 ---- double *lastPtr; /* Return position of char just after * last visible one. */ { + #ifdef KANJI + wchar *displayString; + #else char *displayString; + #endif /* KANJI */ int charsInWindow, endX; if (entryPtr->displayString == NULL) { *************** *** 2221,2226 **** --- 2527,2535 ---- { register Entry *entryPtr = (Entry *) clientData; char *value; + #ifdef KANJI + wchar *wstr; + #endif /* KANJI */ /* * If the variable is unset, then immediately recreate it unless *************** *** 2229,2236 **** --- 2538,2550 ---- if (flags & TCL_TRACE_UNSETS) { if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) { + #ifdef KANJI + Tcl_SetVar(interp, entryPtr->textVarName, + Tk_DecodeWStr(entryPtr->string), TCL_GLOBAL_ONLY); + #else Tcl_SetVar(interp, entryPtr->textVarName, entryPtr->string, TCL_GLOBAL_ONLY); + #endif /* KANJI */ Tcl_TraceVar(interp, entryPtr->textVarName, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, EntryTextVarProc, clientData); *************** *** 2249,2256 **** --- 2563,2646 ---- if (value == NULL) { value = ""; } + #ifdef KANJI + wstr = Tk_GetWStr(interp, value); + if (Tcl_WStrcmp(wstr, entryPtr->string) != 0) { + EntrySetValue(entryPtr, value); + } + Tk_FreeWStr(wstr); + #else if (strcmp(value, entryPtr->string) != 0) { EntrySetValue(entryPtr, value); } + #endif /* KANJI */ return (char *) NULL; } + + #ifdef KINPUT2 + /* + *-------------------------------------------------------------- + * + * EntryXYPos -- + * + * This procedure returns XY coordinates of the point + * specified by its index. The Y coordinate is of + * the baseline. + * + * Results: + * The return value is always TCL_OK (i.e. no errors possible). + * If the point is visible, this procedure will return a list + * containing its X and Y position. Othewise, an empty string + * will be returned. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + + static int + EntryXYPos(interp, entryPtr, index) + Tcl_Interp *interp; /* For the result */ + Entry *entryPtr; /* Entry for which the index is being + * specified. */ + int index; /* Character index for which its position + * is to be retrieved. */ + { + Tk_Window tkwin = entryPtr->tkwin; + int leftidx = entryPtr->leftIndex; + int posX, posY; + int nchars; + + if (entryPtr->tkwin != NULL && Tk_IsMapped(tkwin) && index >= leftidx) { + + /* + * Compute X-coordinate of the "index" character + */ + + if (index == leftidx) { + posX = entryPtr->inset; + } else { + nchars = TkMeasureChars(entryPtr->fontPtr, + entryPtr->string + leftidx, + index - leftidx, + entryPtr->inset, + Tk_Width(tkwin) - entryPtr->inset, + entryPtr->inset, + TK_PARTIAL_OK|TK_NEWLINES_NOT_SPECIAL, + &posX); + if (nchars < index - leftidx) return TCL_OK; + } + + /* + * Y-coordinate is of the baseline + */ + posY = (Tk_Height(tkwin) + entryPtr->fontPtr->ascent + - entryPtr->fontPtr->descent)/2; + + sprintf(interp->result, "%d %d", posX, posY); + } + + return TCL_OK; + } + #endif /* KINPUT2 */ diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/generic/tkFont.c ./generic/tkFont.c *** ../tk4.2/generic/tkFont.c Tue Aug 27 02:09:16 1996 --- ./generic/tkFont.c Fri Oct 18 13:14:49 1996 *************** *** 18,23 **** --- 18,27 ---- #include "tkPort.h" #include "tkInt.h" + #ifdef KANJI + #define MAX(a, b) ((a) > (b) ? (a) : (b)) + #endif /* KANJI */ + /* * This module caches extra information about fonts in addition to * what X already provides. The extra information is used by the *************** *** 49,54 **** --- 53,68 ---- #define NEWLINE 3 #define REPLACE 4 #define SKIP 5 + #ifdef KANJI + /* + * new character type for Kanji: + * WRAPUP: like NORMAL, but needs special treatment + * for word wrapping. This character should not + * appear at the beginning of a line. + * (something like '.' or ',') + */ + #define WRAPUP 6 + #endif /* KANJI */ /* * One of the following data structures exists for each font that is *************** *** 97,102 **** --- 111,120 ---- static TkFont *lastFontPtr = NULL; static XFontStruct *lastFontStructPtr = NULL; + #ifdef KANJI + static TkFont *lastKanjiFontPtr = NULL; + static XFontStruct *lastKanjiFontStructPtr = NULL; + #endif /* KANJI */ /* * Characters used when displaying control sequences. *************** *** 123,128 **** --- 141,149 ---- static void FontInit _ANSI_ARGS_((void)); static void SetFontMetrics _ANSI_ARGS_((TkFont *fontPtr)); + #ifdef KANJI + static void SetKanjiFontMetrics _ANSI_ARGS_((TkFont *kanjiFontPtr)); + #endif /* KANJI */ /* *---------------------------------------------------------------------- *************** *** 307,313 **** --- 328,342 ---- ckfree((char *) fontPtr->widths); } ckfree((char *) fontPtr); + #ifdef KANJI + if (fontStructPtr == lastFontStructPtr) { + lastFontStructPtr = NULL; + } else if (fontStructPtr == lastKanjiFontStructPtr) { + lastKanjiFontStructPtr = NULL; + } + #else lastFontStructPtr = NULL; + #endif /* KANJI */ } } *************** *** 361,366 **** --- 390,410 ---- register XFontStruct *fontStructPtr = fontPtr->fontStructPtr; char *p; + #ifdef KANJI + #if defined(__WIN32__) + /* + * Since Windows Kanji font also contains ascii fonts, We allow + * users to use a Kanji (SHIFTJIS_CHARSET) font for an ascii font + * option, like first "k14" in + * "button .b -text foo -font k14 -kanjifont k14". + * Note k14 is the alias to MS mincho 14pts font on Windows version. + */ + if (fontStructPtr->max_byte1 != 0) { + SetKanjiFontMetrics(fontPtr); + return; + } + #endif /* __WIN32__ */ + #endif /* KANJI */ /* * Pass 1: initialize the arrays. */ *************** *** 371,376 **** --- 415,436 ---- fontPtr->types[i] = REPLACE; } + #ifdef KANJI + /* + * Pass 1.5: if the given font is a 2byte font (e.g. kanji + * font) and there are no characters in the range between + * 0-256, make all the characters undisplayable. + */ + if (fontStructPtr->min_byte1 > 0) { + for (i = 0; i < 256; i++) { + fontPtr->types[i] = SKIP; + fontPtr->widths[i] = 0; + } + fontPtr->tabWidth = 1; + return; + } + #endif /* KANJI */ + /* * Pass 2: for all characters that exist in the font and are * not control characters, fill in the type and width *************** *** 448,453 **** --- 508,586 ---- } } + #ifdef KANJI + /* + *-------------------------------------------------------------- + * + * SetKanjiFontMetrics -- + * + * This procedure is called to fill in the "widths" and "types" + * arrays for a kanji font. + * + * Results: + * None. + * + * Side effects: + * FontPtr gets modified to hold font metric information. + * + *-------------------------------------------------------------- + */ + + static void + SetKanjiFontMetrics(fontPtr) + register TkFont *fontPtr; + { + register XFontStruct *fontStructPtr = fontPtr->fontStructPtr; + register int min_byte1 = fontStructPtr->min_byte1; + register int max_byte1 = fontStructPtr->max_byte1; + register int min_byte2 = fontStructPtr->min_char_or_byte2; + register int max_byte2 = fontStructPtr->max_char_or_byte2; + register int rownum = max_byte2 - min_byte2 + 1; + register int i, j, n; + static char wrapupchars1[] = { 2, 3, 4, 5, 9, 10, 28, 55, 57, 0 }; + static char wrapupchars4[] = { 1, 3, 5, 7, 9, 35, 67, 69, 71, 78, 0 }; + static char wrapupchars5[] = { 1, 3, 5, 7, 9, 35, 67, 69, 71, 78, 85, 86, 0 }; + + #define KANJI_RANGE 32896 /* 128*256+128 */ + fontPtr->types = (char *) ckalloc(KANJI_RANGE); + fontPtr->widths = (unsigned char *) ckalloc(KANJI_RANGE); + memset(fontPtr->types, SKIP, KANJI_RANGE); + memset((char *)fontPtr->widths, 0, KANJI_RANGE); + + for( i = min_byte1 ; i <= max_byte1 ; i++ ) { + for( j = min_byte2 ; j <= max_byte2 ; j++ ) { + n = (i<<8) + j; + n &= 0x7f7f; /* for EUC encoding kanji font (ex DEC's) */ + if (n < 0 || n > KANJI_RANGE) continue; + fontPtr->types[n] = NORMAL; + #if defined(__WIN32__) + if( i != min_byte1 ) { + fontPtr->widths[n] = fontStructPtr->max_bounds.width; + } else + #endif /* __WIN32__ */ + if( fontStructPtr->per_char == NULL ) { + fontPtr->widths[n] = fontStructPtr->min_bounds.width; + } else { + fontPtr->widths[n] = fontStructPtr->per_char[ + (i-min_byte1)*rownum+(j-min_byte2)].width; + } + } + } + for (i = 0; wrapupchars1[i] > 0; i++) { + n = 0x2120 + wrapupchars1[i]; + if (fontPtr->types[n] == NORMAL) fontPtr->types[n] = WRAPUP; + } + for (i = 0; wrapupchars4[i] > 0; i++) { + n = 0x2420 + wrapupchars4[i]; + if (fontPtr->types[n] == NORMAL) fontPtr->types[n] = WRAPUP; + } + for (i = 0; wrapupchars5[i] > 0; i++) { + n = 0x2520 + wrapupchars5[i]; + if (fontPtr->types[n] == NORMAL) fontPtr->types[n] = WRAPUP; + } + } + #endif /* KANJI */ + /* *-------------------------------------------------------------- * *************** *** 975,977 **** --- 1108,1729 ---- } } } + + #ifdef KANJI + /* + *-------------------------------------------------------------- + * + * TkMeasureWChars -- + * + * Measure the number of characters from a string that + * will fit in a given horizontal span. The measurement + * is done under the assumption that TkDisplayChars will + * be used to actually display the characters. + * + * Results: + * The return value is the number of characters from source + * that fit in the span given by startX and maxX. *nextXPtr + * is filled in with the x-coordinate at which the first + * character that didn't fit would be drawn, if it were to + * be drawn. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + + int + TkMeasureWChars(fontSetPtr, source, maxChars, startX, maxX, + tabOrigin, flags, nextXPtr) + XWSFontSet *fontSetPtr; /* FontSet in which to draw characters. */ + wchar *source; /* Characters to be displayed. Need not + * be NULL-terminated. */ + int maxChars; /* Maximum # of characters to consider from + * source. */ + int startX; /* X-position at which first character will + * be drawn. */ + int maxX; /* Don't consider any character that would + * cross this x-position. */ + int tabOrigin; /* X-location that serves as "origin" for + * tab stops. */ + int flags; /* Various flag bits OR-ed together. + * TK_WHOLE_WORDS means stop on a word boundary + * (just before a space character) if + * possible. TK_AT_LEAST_ONE means always + * return a value of at least one, even + * if the character doesn't fit. + * TK_PARTIAL_OK means it's OK to display only + * a part of the last character in the line. + * TK_NEWLINES_NOT_SPECIAL means that newlines + * are treated just like other control chars: + * they don't terminate the line,*/ + int *nextXPtr; /* Return x-position of terminating + * character here. */ + { + register TkFont *fontPtr; + register TkFont *asciiFontPtr, *kanjiFontPtr; + register wchar *p; /* Current character. */ + register wchar c; + wchar *term; /* Pointer to most recent character that + * may legally be a terminating character. */ + int termX; /* X-position just after term. */ + int curX; /* X-position corresponding to p. */ + int newX; /* X-position corresponding to p+1. */ + int type; + int rem; + + /* + * Find the TkFont structure for this font, and make sure its + * font metrics exist. + */ + + if (lastFontStructPtr == fontSetPtr->asciiFont) { + asciiFontPtr = lastFontPtr; + } else { + Tcl_HashEntry *fontHashPtr; + + if (!initialized) { + badArg: + panic("TkMeasureWChars received unknown font argument"); + } + + fontHashPtr = Tcl_FindHashEntry(&fontTable, (char *) fontSetPtr->asciiFont); + if (fontHashPtr == NULL) { + goto badArg; + } + asciiFontPtr = (TkFont *) Tcl_GetHashValue(fontHashPtr); + lastFontStructPtr = asciiFontPtr->fontStructPtr; + lastFontPtr = asciiFontPtr; + } + if (asciiFontPtr->types == NULL) { + SetFontMetrics(asciiFontPtr); + } + + if (lastKanjiFontStructPtr == fontSetPtr->kanjiFont) { + kanjiFontPtr = lastKanjiFontPtr; + } else { + Tcl_HashEntry *fontHashPtr; + + if (!initialized) { + goto badArg; + } + + fontHashPtr = Tcl_FindHashEntry(&fontTable, (char *) fontSetPtr->kanjiFont); + if (fontHashPtr == NULL) { + goto badArg; + } + kanjiFontPtr = (TkFont *) Tcl_GetHashValue(fontHashPtr); + lastKanjiFontStructPtr = kanjiFontPtr->fontStructPtr; + lastKanjiFontPtr = kanjiFontPtr; + } + if (kanjiFontPtr->types == NULL) { + SetKanjiFontMetrics(kanjiFontPtr); + } + + /* + * Scan the input string one character at a time, until a character + * is found that crosses maxX. + */ + + newX = curX = startX; + termX = 0; /* Not needed, but eliminates compiler warning. */ + term = source; + for (p = source, c = *p & 0xff; maxChars > 0; p++, maxChars--) { + int gmask; + + gmask = *p & 0x8080; + switch( gmask ) { + case G0MASK: + case G2MASK: + case G3MASK: + fontPtr = asciiFontPtr; + c = *p & 0xff; + break; + case G1MASK: + fontPtr = kanjiFontPtr; + c = *p & 0x7f7f; + break; + } + type = fontPtr->types[c]; + if ((type == NORMAL) || (type == REPLACE) || (type == WRAPUP)) { + newX += fontPtr->widths[c]; + } else if (type == TAB) { + if (!(flags & TK_IGNORE_TABS)) { + newX += fontPtr->tabWidth; + rem = (newX - tabOrigin) % fontPtr->tabWidth; + if (rem < 0) { + rem += fontPtr->tabWidth; + } + newX -= rem; + } + } else if (type == NEWLINE) { + if (flags & TK_NEWLINES_NOT_SPECIAL) { + newX += fontPtr->widths[c]; + } else { + break; + } + } else if (type != SKIP) { + panic("Unknown type %d in TkMeasureWChars", type); + } + if (newX > maxX) { + break; + } + if (maxChars > 1) { + c = p[1] & 0x7f7f; + } else { + c = 0; + } + if (ISWSPACE(c) || (c == 0)) { + term = p+1; + termX = newX; + } + curX = newX; + } + + /* + * P points to the first character that doesn't fit in the desired + * span. Use the flags to figure out what to return. + */ + + #define IsG0(c) (((c) & 0x8000) == 0) /* G0 or G2, actually */ + #define IsG1(c) (((c) & 0x8080) == 0x8080) + #define IsWrapup(c) (kanjiFontPtr->types[(c)&0x7f7f] == WRAPUP) + + if ((flags & TK_PARTIAL_OK) && (curX < maxX)) { + curX = newX; + p++; + } + if ((flags & TK_AT_LEAST_ONE) && (term == source) && (maxChars > 0) + && !ISWSPACE(*term)) { + term = p; + termX = curX; + if (term == source) { + term++; + termX = newX; + } + } else if ((maxChars == 0) || + !IsG0(*p) || (p > source && !IsG0(p[-1])) || + !(flags & TK_WHOLE_WORDS)) { + if ((flags & TK_WHOLE_WORDS) && maxChars > 0 && p > source + 1 && + IsG1(p[-1]) && IsG1(p[0]) && IsWrapup(p[0])) { + term = p - 1; + termX = curX - kanjiFontPtr->widths[p[-1] & 0x7f7f]; + } else { + term = p; + termX = curX; + } + } + *nextXPtr = termX; + return term-source; + } + + /* + *-------------------------------------------------------------- + * + * TkDisplayWChars -- + * + * Draw a string of characters on the screen, converting + * tabs to the right number of spaces and control characters + * to sequences of the form "\xhh" where hh are two hex + * digits. + * + * Results: + * None. + * + * Side effects: + * Information gets drawn on the screen. + * + *-------------------------------------------------------------- + */ + + void + TkDisplayWChars(display, drawable, gcset, fontSetPtr, string, numChars, + x, y, tabOrigin, flags) + Display *display; /* Display on which to draw. */ + Drawable drawable; /* Window or pixmap in which to draw. */ + XWSGC gcset; /* Graphics context for actually drawing + * characters. */ + XWSFontSet *fontSetPtr; /* Font used in GC; must have been allocated + * by Tk_GetFontStruct. Used to compute sizes + * of tabs, etc. */ + wchar *string; /* Characters to be displayed. */ + int numChars; /* Number of characters to display from + * string. */ + int x, y; /* Coordinates at which to draw string. */ + int tabOrigin; /* X-location that serves as "origin" for + * tab stops. */ + int flags; /* Flags to control display. Only + * TK_NEWLINES_NOT_SPECIAL is supported right + * now. See TkMeasureChars for information + * about it. */ + { + register TkFont *fontPtr; + register TkFont *asciiFontPtr, *kanjiFontPtr; + register wchar *p; /* Current character being scanned. */ + register wchar c; + int type; + wchar *start; /* First character waiting to be displayed. */ + int startX; /* X-coordinate corresponding to start. */ + int curX; /* X-coordinate corresponding to p. */ + wchar replace[10]; + int rem; + + /* + * Find the TkFont structure for this font, and make sure its + * font metrics exist. + */ + + if (lastFontStructPtr == fontSetPtr->asciiFont) { + asciiFontPtr = lastFontPtr; + } else { + Tcl_HashEntry *fontHashPtr; + + if (!initialized) { + badArg: + panic("TkDisplayWChars received unknown font argument"); + } + + fontHashPtr = Tcl_FindHashEntry(&fontTable, (char *) fontSetPtr->asciiFont); + if (fontHashPtr == NULL) { + goto badArg; + } + asciiFontPtr = (TkFont *) Tcl_GetHashValue(fontHashPtr); + lastFontStructPtr = asciiFontPtr->fontStructPtr; + lastFontPtr = asciiFontPtr; + } + if (asciiFontPtr->types == NULL) { + SetFontMetrics(asciiFontPtr); + } + + if (lastKanjiFontStructPtr == fontSetPtr->kanjiFont) { + kanjiFontPtr = lastKanjiFontPtr; + } else { + Tcl_HashEntry *fontHashPtr; + + if (!initialized) { + goto badArg; + } + + fontHashPtr = Tcl_FindHashEntry(&fontTable, (char *) fontSetPtr->kanjiFont); + if (fontHashPtr == NULL) { + goto badArg; + } + kanjiFontPtr = (TkFont *) Tcl_GetHashValue(fontHashPtr); + lastKanjiFontStructPtr = kanjiFontPtr->fontStructPtr; + lastKanjiFontPtr = kanjiFontPtr; + } + if (kanjiFontPtr->types == NULL) { + SetKanjiFontMetrics(kanjiFontPtr); + } + + /* + * Scan the string one character at a time. Display control + * characters immediately, but delay displaying normal characters + * in order to pass many characters to the server all together. + */ + + startX = curX = x; + start = string; + for (p = string; numChars > 0; numChars--, p++) { + int gmask; + + gmask = *p & 0x8080; + switch( gmask ) { + case G0MASK: + case G2MASK: + case G3MASK: + fontPtr = asciiFontPtr; + c = *p & 0xff; + break; + case G1MASK: + fontPtr = kanjiFontPtr; + c = *p & 0x7f7f; + break; + } + type = fontPtr->types[c]; + if (type == NORMAL || type == WRAPUP) { + curX += fontPtr->widths[c]; + continue; + } + if (p != start) { + TkWSDrawString(display, drawable, gcset, startX, y, start, p - start); + startX = curX; + } + if (type == TAB) { + if (!(flags & TK_IGNORE_TABS)) { + curX += fontPtr->tabWidth; + rem = (curX - tabOrigin) % fontPtr->tabWidth; + if (rem < 0) { + rem += fontPtr->tabWidth; + } + curX -= rem; + } + } else if (type == REPLACE || + (type == NEWLINE && flags & TK_NEWLINES_NOT_SPECIAL)) { + if ((c < sizeof(mapChars)) && (mapChars[c] != 0)) { + replace[0] = '\\'; + replace[1] = mapChars[c]; + TkWSDrawString(display, drawable, gcset, startX, y, replace, 2); + curX += fontPtr->widths[replace[0]] + + fontPtr->widths[replace[1]]; + } else { + replace[0] = '\\'; + replace[1] = 'x'; + replace[2] = hexChars[(c >> 4) & 0xf]; + replace[3] = hexChars[c & 0xf]; + TkWSDrawString(display, drawable, gcset, startX, y, replace, 4); + curX += fontPtr->widths[replace[0]] + + fontPtr->widths[replace[1]] + + fontPtr->widths[replace[2]] + + fontPtr->widths[replace[3]]; + } + } else if (type == NEWLINE) { + y += fontSetPtr->ascent + fontSetPtr->descent; + curX = x; + } else if (type != SKIP) { + panic("Unknown type %d in TkDisplayChars", type); + } + startX = curX; + start = p+1; + } + + /* + * At the very end, there may be one last batch of normal characters + * to display. + */ + + if (p != start) { + TkWSDrawString(display, drawable, gcset, startX, y, start, p - start); + } + } + + /* + *---------------------------------------------------------------------- + * + * TkUnderlineWChars -- + * + * This procedure draws an underline for a given range of characters + * in a given string, using appropriate information for the string's + * font. It doesn't draw the characters (which are assumed to have + * been displayed previously); it just draws the underline. + * + * Results: + * None. + * + * Side effects: + * Information gets displayed in "drawable". + * + *---------------------------------------------------------------------- + */ + + void + TkUnderlineWChars(display, drawable, gcset, fontSetPtr, string, x, y, + tabOrigin, flags, firstChar, lastChar) + Display *display; /* Display on which to draw. */ + Drawable drawable; /* Window or pixmap in which to draw. */ + XWSGC gcset; /* Graphics context for actually drawing + * underline. */ + XWSFontSet *fontSetPtr; /* Font used in GC; must have been allocated + * by Tk_GetFontStruct. Used to character + * dimensions, etc. */ + wchar *string; /* String containing characters to be + * underlined. */ + int x, y; /* Coordinates at which first character of + * string is drawn. */ + int tabOrigin; /* X-location that serves as "origin" for + * tab stops. */ + int flags; /* Flags that were passed to TkDisplayChars. */ + int firstChar; /* Index of first character to underline. */ + int lastChar; /* Index of last character to underline. */ + { + int xUnder, yUnder, width, height; + unsigned long aValue, kValue; + + /* + * First compute the vertical span of the underline, using font + * properties if they exist. + */ + + if (!XGetFontProperty(fontSetPtr->asciiFont, XA_UNDERLINE_POSITION, &aValue)) { + aValue = 0; + } + if (!XGetFontProperty(fontSetPtr->kanjiFont, XA_UNDERLINE_POSITION, &kValue)) { + kValue = 0; + } + if (aValue && kValue) { + yUnder = y + MAX(aValue, kValue); + } else { + yUnder = y + fontSetPtr->max_bounds.descent/2; + } + if (!XGetFontProperty(fontSetPtr->asciiFont, XA_UNDERLINE_THICKNESS, &aValue)) { + aValue = 0; + } + if (!XGetFontProperty(fontSetPtr->kanjiFont, XA_UNDERLINE_THICKNESS, &kValue)) { + kValue = 0; + } + if (aValue && kValue) { + height = MAX(aValue, kValue); + } else { + height = 2; + } + + /* + * Now compute the horizontal span of the underline. + */ + + TkMeasureWChars(fontSetPtr, string, firstChar, x, (int) 1000000, + tabOrigin, flags, &xUnder); + TkMeasureWChars(fontSetPtr, string+firstChar, lastChar+1-firstChar, + xUnder, (int) 1000000, tabOrigin, flags, &width); + width -= xUnder; + + XFillRectangle(display, drawable, gcset->fe[0].gc, xUnder, yUnder, + (unsigned int) width, (unsigned int) height); + } + + /* + *---------------------------------------------------------------------- + * + * TkWSComputeTextGeometry -- + * + * This procedure computes the amount of screen space needed to + * display a multi-line string of text. + * + * Results: + * There is no return value. The dimensions of the screen area + * needed to display the text are returned in *widthPtr, and *heightPtr. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + void + TkWSComputeTextGeometry(fontSetPtr, string, numChars, wrapLength, + widthPtr, heightPtr) + XWSFontSet *fontSetPtr; /* Font that will be used to display text. */ + wchar *string; /* String whose dimensions are to be + * computed. */ + int numChars; /* Number of characters to consider from + * string. */ + int wrapLength; /* Longest permissible line length, in + * pixels. <= 0 means no automatic wrapping: + * just let lines get as long as needed. */ + int *widthPtr; /* Store width of string here. */ + int *heightPtr; /* Store height of string here. */ + { + int thisWidth, maxWidth, numLines; + wchar *p; + + if (wrapLength <= 0) { + wrapLength = INT_MAX; + } + maxWidth = 0; + for (numLines = 1, p = string; (p - string) < numChars; numLines++) { + p += TkMeasureWChars(fontSetPtr, p, numChars - (p - string), 0, + wrapLength, 0, TK_WHOLE_WORDS|TK_AT_LEAST_ONE, &thisWidth); + if (thisWidth > maxWidth) { + maxWidth = thisWidth; + } + if (*p == 0) { + break; + } + + /* + * If the character that didn't fit in this line was a white + * space character then skip it. + */ + + if (ISWSPACE(*p)) { + p++; + } + } + *widthPtr = maxWidth; + *heightPtr = numLines * (fontSetPtr->ascent + fontSetPtr->descent); + } + + /* + *---------------------------------------------------------------------- + * + * TkWSDisplayText -- + * + * description. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + void + TkWSDisplayText(display, drawable, fontSetPtr, string, numChars, x, y, + length, justify, underline, gcset) + Display *display; /* X display to use for drawing text. */ + Drawable drawable; /* Window or pixmapin which to draw the + * text. */ + XWSFontSet *fontSetPtr; /* Font that determines geometry of text + * (should be same as font in gc). */ + wchar *string; /* String to display; may contain embedded + * newlines. */ + int numChars; /* Number of characters to use from string. */ + int x, y; /* Pixel coordinates within drawable of + * upper left corner of display area. */ + int length; /* Line length in pixels; used to compute + * word wrap points and also for + * justification. Must be > 0. */ + Tk_Justify justify; /* How to justify lines. */ + int underline; /* Index of character to underline, or < 0 + * for no underlining. */ + XWSGC gcset; /* Graphics context to use for drawing text. */ + { + wchar *p; + int charsThisLine, lengthThisLine, xThisLine; + + /* + * Work through the string one line at a time. Display each line + * in four steps: + * 1. Compute the line's length. + * 2. Figure out where to display the line for justification. + * 3. Display the line. + * 4. Underline one character if needed. + */ + + y += fontSetPtr->ascent; + for (p = string; numChars > 0; ) { + charsThisLine = TkMeasureWChars(fontSetPtr, p, numChars, 0, length, + 0, TK_WHOLE_WORDS|TK_AT_LEAST_ONE, &lengthThisLine); + if (justify == TK_JUSTIFY_LEFT) { + xThisLine = x; + } else if (justify == TK_JUSTIFY_CENTER) { + xThisLine = x + (length - lengthThisLine)/2; + } else { + xThisLine = x + (length - lengthThisLine); + } + TkDisplayWChars(display, drawable, gcset, fontSetPtr, p, charsThisLine, + xThisLine, y, xThisLine, 0); + if ((underline >= 0) && (underline < charsThisLine)) { + TkUnderlineWChars(display, drawable, gcset, fontSetPtr, p, + xThisLine, y, xThisLine, 0, underline, underline); + } + p += charsThisLine; + numChars -= charsThisLine; + underline -= charsThisLine; + y += fontSetPtr->ascent + fontSetPtr->descent; + + /* + * If the character that didn't fit was a space character, skip it. + */ + + if (ISWSPACE(*p)) { + p++; + numChars--; + underline--; + } + } + } + #endif /* KANJI */ diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/generic/tkInt.h ./generic/tkInt.h *** ../tk4.2/generic/tkInt.h Sun Oct 13 09:29:51 1996 --- ./generic/tkInt.h Fri Oct 18 13:14:49 1996 *************** *** 697,702 **** --- 697,709 ---- char *string, int numChars, int x, int y, int length, Tk_Justify justify, int underline, GC gc)); + #ifdef KANJI + EXTERN void TkDisplayWChars _ANSI_ARGS_((Display *display, + Drawable drawable, XWSGC gcset, + XWSFontSet *fontSetPtr, wchar *string, + int numChars, int x, int y, int tabOrigin, + int flags)); + #endif /* KANJI */ EXTERN void TkEventCleanupProc _ANSI_ARGS_(( ClientData clientData, Tcl_Interp *interp)); EXTERN void TkEventDeadWindow _ANSI_ARGS_((TkWindow *winPtr)); *************** *** 771,776 **** --- 778,788 ---- EXTERN int TkMeasureChars _ANSI_ARGS_((XFontStruct *fontStructPtr, char *source, int maxChars, int startX, int maxX, int tabOrigin, int flags, int *nextXPtr)); + #ifdef KANJI + EXTERN int TkMeasureWChars _ANSI_ARGS_((XWSFontSet *fontSetPtr, + wchar *source, int maxChars, int startX, int maxX, + int tabOrigin, int flags, int *nextXPtr)); + #endif /* KANJI */ EXTERN void TkOptionClassChanged _ANSI_ARGS_((TkWindow *winPtr)); EXTERN void TkOptionDeadWindow _ANSI_ARGS_((TkWindow *winPtr)); EXTERN int TkOvalToArea _ANSI_ARGS_((double *ovalPtr, *************** *** 816,821 **** --- 828,839 ---- TkRegion rgn)); #endif EXTERN void TkSelPropProc _ANSI_ARGS_((XEvent *eventPtr)); + #ifdef KANJI + EXTERN int TkSetWMCommand _ANSI_ARGS_((TkWindow *winPtr, + char **argv, int argc)); + EXTERN int TkSetWMTextProperty _ANSI_ARGS_((TkWindow *winPtr, + Atom wmatom, char *str)); + #endif /* KANJI */ EXTERN int TkThickPolyLineToArea _ANSI_ARGS_((double *coordPtr, int numPoints, double width, int capStyle, int joinStyle, double *rectPtr)); *************** *** 825,830 **** --- 843,855 ---- XFontStruct *fontStructPtr, char *string, int x, int y, int tabOrigin, int flags, int firstChar, int lastChar)); + #ifdef KANJI + EXTERN void TkUnderlineWChars _ANSI_ARGS_((Display *display, + Drawable drawable, XWSGC gcset, + XWSFontSet *fontSetPtr, wchar *string, + int x, int y, int tabOrigin, int flags, + int firstChar, int lastChar)); + #endif /* KANJI */ #ifndef TkUnionRectWithRegion EXTERN void TkUnionRectWithRegion _ANSI_ARGS_((XRectangle* rect, TkRegion src, TkRegion dr_return)); *************** *** 842,847 **** --- 867,889 ---- int aboveBelow, TkWindow *otherPtr)); EXTERN void TkWmSetClass _ANSI_ARGS_((TkWindow *winPtr)); EXTERN void TkWmUnmapWindow _ANSI_ARGS_((TkWindow *winPtr)); + #ifdef KANJI + EXTERN void TkWSComputeTextGeometry _ANSI_ARGS_(( + XWSFontSet *fontSetPtr, wchar *string, + int numChars, int wrapLength, int *widthPtr, + int *heightPtr)); + EXTERN void TkWSDisplayText _ANSI_ARGS_((Display *display, + Drawable drawable, XWSFontSet *fontSetPtr, + wchar *string, int numChars, int x, int y, + int length, Tk_Justify justify, int underline, + XWSGC gcset)); + EXTERN int TkWSDrawString _ANSI_ARGS_ ((Display *display, + Drawable drawable, XWSGC gcset, + int x, int y, wchar *wstring, int length)); + EXTERN void TkWSTextExtents _ANSI_ARGS_ ((XWSGC gcset, + wchar *wstr, int len, + int *ascent, int *decent, XCharStruct *overall)); + #endif /* KANJI */ EXTERN int TkXFileProc _ANSI_ARGS_((ClientData clientData, int mask, int flags)); diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/generic/tkListbox.c ./generic/tkListbox.c *** ../tk4.2/generic/tkListbox.c Tue Aug 27 02:09:41 1996 --- ./generic/tkListbox.c Fri Oct 18 13:14:50 1996 *************** *** 33,47 **** --- 33,53 ---- * it isn't. */ struct Element *nextPtr; /* Next in list of all elements of this * listbox, or NULL for last element. */ + #ifdef KANJI + wchar *text; + #else char text[4]; /* Characters of this element, NULL- * terminated. The actual space allocated * here will be as large as needed (> 4, * most likely). Must be the last field * of the record. */ + #endif /* KANJI */ } Element; + #ifndef KANJI #define ElementSize(stringLength) \ ((unsigned) (sizeof(Element) - 3 + stringLength)) + #endif /* !KANJI */ /* * A data structure of the following type is kept for each listbox *************** *** 84,97 **** --- 90,117 ---- * Indicates how much interior stuff must * be offset from outside edges to leave * room for borders. */ + #ifdef KANJI + XWSFontSet *fontPtr; + XFontStruct *asciiFontPtr; + XFontStruct *kanjiFontPtr; + #else XFontStruct *fontPtr; /* Information about text font, or NULL. */ + #endif /* KANJI */ XColor *fgColorPtr; /* Text color in normal mode. */ + #ifdef KANJI + XWSGC textGC; + #else GC textGC; /* For drawing normal text. */ + #endif /* KANJI */ Tk_3DBorder selBorder; /* Borders and backgrounds for selected * elements. */ int selBorderWidth; /* Width of border around selection. */ XColor *selFgColorPtr; /* Foreground color for selected elements. */ + #ifdef KANJI + XWSGC selTextGC; + #else GC selTextGC; /* For drawing selected text. */ + #endif /* KANJI */ int width; /* Desired width of window, in characters. */ int height; /* Desired height of window, in lines. */ int lineHeight; /* Number of pixels allocated for each line *************** *** 214,221 **** --- 234,248 ---- Tk_Offset(Listbox, exportSelection), 0}, {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL, (char *) NULL, 0, 0}, + #ifdef KANJI + {TK_CONFIG_FONT, "-font", "font", "Font", + DEF_LISTBOX_FONT, Tk_Offset(Listbox, asciiFontPtr), 0}, + {TK_CONFIG_FONT, "-kanjifont", "kanjiFont", "KanjiFont", + DEF_LISTBOX_KANJIFONT, Tk_Offset(Listbox, kanjiFontPtr), 0}, + #else {TK_CONFIG_FONT, "-font", "font", "Font", DEF_LISTBOX_FONT, Tk_Offset(Listbox, fontPtr), 0}, + #endif /* KANJI */ {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground", DEF_LISTBOX_FG, Tk_Offset(Listbox, fgColorPtr), 0}, {TK_CONFIG_INT, "-height", "height", "Height", *************** *** 292,297 **** --- 319,329 ---- static int ListboxFetchSelection _ANSI_ARGS_(( ClientData clientData, int offset, char *buffer, int maxBytes)); + #ifdef KANJI + static int ListboxFetchSelectionCtext _ANSI_ARGS_(( + ClientData clientData, int offset, char *buffer, + int maxBytes)); + #endif /* KANJI */ static void ListboxLostSelection _ANSI_ARGS_(( ClientData clientData)); static void ListboxRedrawRange _ANSI_ARGS_((Listbox *listPtr, *************** *** 372,379 **** --- 404,419 ---- listPtr->highlightColorPtr = NULL; listPtr->inset = 0; listPtr->fontPtr = NULL; + #ifdef KANJI + listPtr->asciiFontPtr = NULL; + listPtr->kanjiFontPtr = NULL; + #endif /* KANJI */ listPtr->fgColorPtr = NULL; + #ifdef KANJI + listPtr->textGC = NULL; + #else listPtr->textGC = None; + #endif /* KANJI */ listPtr->selBorder = NULL; listPtr->selBorderWidth = 0; listPtr->selFgColorPtr = None; *************** *** 409,414 **** --- 449,466 ---- ListboxEventProc, (ClientData) listPtr); Tk_CreateSelHandler(listPtr->tkwin, XA_PRIMARY, XA_STRING, ListboxFetchSelection, (ClientData) listPtr, XA_STRING); + #ifdef KANJI + { + Atom textatom = Tk_InternAtom(tkwin, "TEXT"); + Atom ctextatom = Tk_InternAtom(tkwin, "COMPOUND_TEXT"); + Tk_CreateSelHandler(listPtr->tkwin, XA_PRIMARY, textatom, + ListboxFetchSelectionCtext, + (ClientData) listPtr, ctextatom); + Tk_CreateSelHandler(listPtr->tkwin, XA_PRIMARY, ctextatom, + ListboxFetchSelectionCtext, + (ClientData) listPtr, ctextatom); + } + #endif /* KANJI */ if (ConfigureListbox(interp, listPtr, argc-2, argv+2, 0) != TCL_OK) { goto error; } *************** *** 588,597 **** --- 640,657 ---- } if (elPtr != NULL) { if (argc == 3) { + #ifdef KANJI + interp->result = Tk_DecodeWStr(elPtr->text); + #else interp->result = elPtr->text; + #endif /* KANJI */ } else { for ( ; i <= last; i++, elPtr = elPtr->nextPtr) { + #ifdef KANJI + Tcl_AppendElement(interp, Tk_DecodeWStr(elPtr->text)); + #else Tcl_AppendElement(interp, elPtr->text); + #endif /* KANJI */ } } } *************** *** 898,903 **** --- 958,966 ---- for (elPtr = listPtr->firstPtr; elPtr != NULL; ) { nextPtr = elPtr->nextPtr; + #ifdef KANJI + Tk_FreeWStr(elPtr->text); + #endif /* KANJI */ ckfree((char *) elPtr); elPtr = nextPtr; } *************** *** 908,919 **** --- 971,996 ---- * stuff. */ + #ifdef KANJI + if (listPtr->fontPtr != NULL ) { + Tk_FreeFontSet(listPtr->fontPtr); + } + #endif /* KANJI */ + #ifdef KANJI + if (listPtr->textGC != NULL) { + Tk_FreeGCSet(listPtr->display, listPtr->textGC); + } + if (listPtr->selTextGC != NULL) { + Tk_FreeGCSet(listPtr->display, listPtr->selTextGC); + } + #else if (listPtr->textGC != None) { Tk_FreeGC(listPtr->display, listPtr->textGC); } if (listPtr->selTextGC != None) { Tk_FreeGC(listPtr->display, listPtr->selTextGC); } + #endif /* KANJI */ Tk_FreeOptions(configSpecs, (char *) listPtr, listPtr->display, 0); ckfree((char *) listPtr); } *************** *** 950,955 **** --- 1027,1035 ---- { XGCValues gcValues; GC new; + #ifdef KANJI + XWSGC newGCSet; + #endif /* KANJI */ int oldExport; oldExport = listPtr->exportSelection; *************** *** 958,963 **** --- 1038,1047 ---- return TCL_ERROR; } + #ifdef KANJI + listPtr->fontPtr = Tk_GetFontSet(listPtr->asciiFontPtr, listPtr->kanjiFontPtr); + #endif /* KANJI */ + /* * A few options need special processing, such as setting the * background from a 3-D border. *************** *** 971,992 **** --- 1055,1098 ---- listPtr->inset = listPtr->highlightWidth + listPtr->borderWidth; gcValues.foreground = listPtr->fgColorPtr->pixel; + #ifndef KANJI gcValues.font = listPtr->fontPtr->fid; + #endif /* !KANJI */ gcValues.graphics_exposures = False; + #ifdef KANJI + newGCSet = Tk_GetGCSet(listPtr->tkwin, GCForeground|GCFont|GCGraphicsExposures, + &gcValues, listPtr->fontPtr); + if (listPtr->textGC != NULL) { + Tk_FreeGCSet(listPtr->display, listPtr->textGC); + } + listPtr->textGC = newGCSet; + #else new = Tk_GetGC(listPtr->tkwin, GCForeground|GCFont|GCGraphicsExposures, &gcValues); if (listPtr->textGC != None) { Tk_FreeGC(listPtr->display, listPtr->textGC); } listPtr->textGC = new; + #endif /* KANJI */ gcValues.foreground = listPtr->selFgColorPtr->pixel; + #ifndef KANJI gcValues.font = listPtr->fontPtr->fid; + #endif /* !KANJI */ + #ifdef KANJI + newGCSet = Tk_GetGCSet(listPtr->tkwin, GCForeground|GCFont, &gcValues, + listPtr->fontPtr); + if (listPtr->selTextGC != NULL) { + Tk_FreeGCSet(listPtr->display, listPtr->selTextGC); + } + listPtr->selTextGC = newGCSet; + #else new = Tk_GetGC(listPtr->tkwin, GCForeground|GCFont, &gcValues); if (listPtr->selTextGC != None) { Tk_FreeGC(listPtr->display, listPtr->selTextGC); } listPtr->selTextGC = new; + #endif /* KANJI */ /* * Claim the selection if we've suddenly started exporting it and *************** *** 1033,1039 **** --- 1139,1149 ---- register Listbox *listPtr = (Listbox *) clientData; register Tk_Window tkwin = listPtr->tkwin; register Element *elPtr; + #ifdef KANJI + XWSGC gc; + #else GC gc; + #endif /* KANJI */ int i, limit, x, y, width, prevSelected; int left, right; /* Non-zero values here indicate * that the left or right edge of *************** *** 1140,1154 **** --- 1250,1273 ---- y += listPtr->fontPtr->ascent + listPtr->selBorderWidth; x = listPtr->inset + listPtr->selBorderWidth - elPtr->lBearing - listPtr->xOffset; + #ifdef KANJI + TkWSDrawString(listPtr->display, pixmap, gc, x, y, + elPtr->text, elPtr->textLength); + #else XDrawString(listPtr->display, pixmap, gc, x, y, elPtr->text, elPtr->textLength); + #endif /* KANJI */ /* * If this is the active element, underline it. */ if ((i == listPtr->active) && (listPtr->flags & GOT_FOCUS)) { + #ifdef KANJI + XFillRectangle(listPtr->display, pixmap, gc->fe[0].gc, + #else XFillRectangle(listPtr->display, pixmap, gc, + #endif /* KANJI */ listPtr->inset + listPtr->selBorderWidth - listPtr->xOffset, y + listPtr->fontPtr->descent - 1, *************** *** 1176,1184 **** --- 1295,1309 ---- } Tk_DrawFocusHighlight(tkwin, gc, listPtr->highlightWidth, pixmap); } + #ifdef KANJI + XCopyArea(listPtr->display, pixmap, Tk_WindowId(tkwin), + listPtr->textGC->fe[0].gc, 0, 0, (unsigned) Tk_Width(tkwin), + (unsigned) Tk_Height(tkwin), 0, 0); + #else XCopyArea(listPtr->display, pixmap, Tk_WindowId(tkwin), listPtr->textGC, 0, 0, (unsigned) Tk_Width(tkwin), (unsigned) Tk_Height(tkwin), 0, 0); + #endif /* KANJI */ Tk_FreePixmap(listPtr->display, pixmap); } *************** *** 1222,1233 **** --- 1347,1367 ---- XCharStruct bbox; if (fontChanged || maxIsStale) { + #ifdef KANJI + listPtr->xScrollUnit = XTextWidth(listPtr->asciiFontPtr, "0", 1); + #else listPtr->xScrollUnit = XTextWidth(listPtr->fontPtr, "0", 1); + #endif /* KANJI */ listPtr->maxWidth = 0; for (elPtr = listPtr->firstPtr; elPtr != NULL; elPtr = elPtr->nextPtr) { if (fontChanged) { + #ifdef KANJI + TkWSTextExtents(listPtr->textGC, elPtr->text, elPtr->textLength, + &dummy, &dummy, &bbox); + #else XTextExtents(listPtr->fontPtr, elPtr->text, elPtr->textLength, &dummy, &dummy, &dummy, &bbox); + #endif /* KANJI */ elPtr->lBearing = bbox.lbearing; elPtr->pixelWidth = bbox.rbearing - bbox.lbearing; } *************** *** 1326,1337 **** --- 1460,1482 ---- oldMaxWidth = listPtr->maxWidth; for (i = argc ; i > 0; i--, argv++, prevPtr = newPtr) { + #ifdef KANJI + newPtr = (Element *)ckalloc((unsigned)sizeof(Element)); + newPtr->text = Tk_GetWStr(listPtr->interp, *argv); + newPtr->textLength = Tcl_WStrlen(newPtr->text); + #else length = strlen(*argv); newPtr = (Element *) ckalloc(ElementSize(length)); newPtr->textLength = length; strcpy(newPtr->text, *argv); + #endif /* KANJI */ + #ifdef KANJI + TkWSTextExtents(listPtr->textGC, newPtr->text, newPtr->textLength, + &dummy, &dummy, &bbox); + #else XTextExtents(listPtr->fontPtr, newPtr->text, newPtr->textLength, &dummy, &dummy, &dummy, &bbox); + #endif /* KANJI */ newPtr->lBearing = bbox.lbearing; newPtr->pixelWidth = bbox.rbearing - bbox.lbearing; if (newPtr->pixelWidth > listPtr->maxWidth) { *************** *** 1457,1462 **** --- 1602,1610 ---- if (elPtr->selected) { listPtr->numSelected -= 1; } + #ifdef KANJI + Tk_FreeWStr(elPtr->text); + #endif /* KANJI */ ckfree((char *) elPtr); } listPtr->numElements -= count; *************** *** 2028,2034 **** --- 2176,2186 ---- if (needNewline) { Tcl_DStringAppend(&selection, "\n", 1); } + #ifdef KANJI + Tcl_DStringAppend(&selection, Tk_DecodeWStr(elPtr->text), elPtr->textLength); + #else Tcl_DStringAppend(&selection, elPtr->text, elPtr->textLength); + #endif /* KANJI */ needNewline = 1; } } *************** *** 2057,2062 **** --- 2209,2297 ---- Tcl_DStringFree(&selection); return count; } + + #ifdef KANJI + /* + *---------------------------------------------------------------------- + * + * ListboxFetchSelectionCtext -- + * + * This procedure is similar to ListboxFetchSelection except + * it converts the selection to COMPOUND_TEXT before + * passing it to the requester. + * + * Results: + * See ListboxFetchSelection. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + static int + ListboxFetchSelectionCtext(clientData, offset, buffer, maxBytes) + ClientData clientData; /* Information about listbox widget. */ + int offset; /* Offset within selection of first + * byte to be returned. */ + char *buffer; /* Location in which to place + * selection. */ + int maxBytes; /* Maximum number of bytes to place + * at buffer, not including terminating + * NULL character. */ + { + register Listbox *listPtr = (Listbox *) clientData; + register Element *elPtr; + Tcl_DString selection; + int length, count, needNewline; + char *ctext; + + if (!listPtr->exportSelection) { + return -1; + } + + /* + * Use a dynamic string to accumulate the contents of the selection. + */ + + needNewline = 0; + Tcl_DStringInit(&selection); + for (elPtr = listPtr->firstPtr; elPtr != NULL; elPtr = elPtr->nextPtr) { + if (elPtr->selected) { + if (needNewline) { + Tcl_DStringAppend(&selection, "\n", 1); + } + ctext = Tk_WStrToCtext(elPtr->text, -1); + Tcl_DStringAppend(&selection, ctext, strlen(ctext)); + ckfree(ctext); + needNewline = 1; + } + } + + length = Tcl_DStringLength(&selection); + if (length == 0) { + return -1; + } + + /* + * Copy the requested portion of the selection to the buffer. + */ + + count = length - offset; + if (count <= 0) { + count = 0; + } else { + if (count > maxBytes) { + count = maxBytes; + } + memcpy((VOID *) buffer, + (VOID *) (Tcl_DStringValue(&selection) + offset), count); + } + buffer[count] = '\0'; + Tcl_DStringFree(&selection); + return count; + } + #endif /* KANJI */ /* *---------------------------------------------------------------------- diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/generic/tkMenu.c ./generic/tkMenu.c *** ../tk4.2/generic/tkMenu.c Tue Aug 27 02:09:41 1996 --- ./generic/tkMenu.c Fri Oct 18 13:14:51 1996 *************** *** 19,24 **** --- 19,30 ---- #include "default.h" #include "tkInt.h" + #ifdef KANJI + #define TkMeasureChars TkMeasureWChars + #define TkDisplayChars TkDisplayWChars + #define TkUnderlineChars TkUnderlineWChars + #endif /* KANJI */ + /* * One of the following data structures is kept for each entry of each * menu managed by this file: *************** *** 28,35 **** --- 34,45 ---- int type; /* Type of menu entry; see below for * valid types. */ struct Menu *menuPtr; /* Menu with which this entry is associated. */ + #ifdef KANJI + wchar *label; + #else char *label; /* Main text label displayed in entry (NULL * if no label). Malloc'ed. */ + #endif /* KANJI */ int labelLength; /* Number of non-NULL characters in label. */ int underline; /* Index of character to underline. */ Pixmap bitmap; /* Bitmap to display in menu entry, or None. *************** *** 44,52 **** --- 54,66 ---- Tk_Image selectImage; /* Image to display in entry when selected, * or NULL if none. Ignored if image is * NULL. */ + #ifdef KANJI + wchar *accel; + #else char *accel; /* Accelerator string displayed at right * of menu entry. NULL means no such * accelerator. Malloc'ed. */ + #endif /* KANJI */ int accelLength; /* Number of non-NULL characters in * accelerator. */ *************** *** 74,81 **** --- 88,106 ---- XColor *activeFg; /* Foreground color to use when entry is * active. NULL means use active foreground * from menu. */ + #ifdef KANJI + XWSFontSet *fontPtr; + XFontStruct *asciiFontPtr; + XFontStruct *kanjiFontPtr; + #else XFontStruct *fontPtr; /* Text font for menu entries. NULL means * use overall font for menu. */ + #endif /* KANJI */ + #ifdef KANJI + XWSGC textGC; + XWSGC activeGC; + XWSGC disabledGC; + #else GC textGC; /* GC for drawing text in entry. NULL means * use overall textGC for menu. */ GC activeGC; /* GC for drawing text in entry when active. *************** *** 86,91 **** --- 111,117 ---- * menu structure. See comments for * disabledFg in menu structure for more * information. */ + #endif /* KANJI */ XColor *indicatorFg; /* Color for indicators in radio and check * button entries. NULL means use indicatorFg * GC from menu. */ *************** *** 164,173 **** --- 190,206 ---- DEF_MENU_ENTRY_ACTIVE_FG, Tk_Offset(MenuEntry, activeFg), COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK |TK_CONFIG_NULL_OK}, + #ifdef KANJI + {TK_CONFIG_WSTRING, "-accelerator", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_ACCELERATOR, Tk_Offset(MenuEntry, accel), + COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK + |TK_CONFIG_NULL_OK}, + #else {TK_CONFIG_STRING, "-accelerator", (char *) NULL, (char *) NULL, DEF_MENU_ENTRY_ACCELERATOR, Tk_Offset(MenuEntry, accel), COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK |TK_CONFIG_NULL_OK}, + #endif /* KANJI */ {TK_CONFIG_BORDER, "-background", (char *) NULL, (char *) NULL, DEF_MENU_ENTRY_BG, Tk_Offset(MenuEntry, border), COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK *************** *** 180,189 **** --- 213,233 ---- DEF_MENU_ENTRY_COMMAND, Tk_Offset(MenuEntry, command), COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK |TK_CONFIG_NULL_OK}, + #ifdef KANJI + {TK_CONFIG_FONT, "-font", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_FONT, Tk_Offset(MenuEntry, asciiFontPtr), + COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK + |TK_CONFIG_NULL_OK}, + {TK_CONFIG_FONT, "-kanjifont", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_FONT, Tk_Offset(MenuEntry, kanjiFontPtr), + COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK + |TK_CONFIG_NULL_OK}, + #else {TK_CONFIG_FONT, "-font", (char *) NULL, (char *) NULL, DEF_MENU_ENTRY_FONT, Tk_Offset(MenuEntry, fontPtr), COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK |TK_CONFIG_NULL_OK}, + #endif /* KANJI */ {TK_CONFIG_COLOR, "-foreground", (char *) NULL, (char *) NULL, DEF_MENU_ENTRY_FG, Tk_Offset(MenuEntry, fg), COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK *************** *** 195,203 **** --- 239,253 ---- {TK_CONFIG_BOOLEAN, "-indicatoron", (char *) NULL, (char *) NULL, DEF_MENU_ENTRY_INDICATOR, Tk_Offset(MenuEntry, indicatorOn), CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|TK_CONFIG_DONT_SET_DEFAULT}, + #ifdef KANJI + {TK_CONFIG_WSTRING, "-label", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_LABEL, Tk_Offset(MenuEntry, label), + COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK}, + #else {TK_CONFIG_STRING, "-label", (char *) NULL, (char *) NULL, DEF_MENU_ENTRY_LABEL, Tk_Offset(MenuEntry, label), COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK}, + #endif /* KANJI */ {TK_CONFIG_STRING, "-menu", (char *) NULL, (char *) NULL, DEF_MENU_ENTRY_MENU, Tk_Offset(MenuEntry, name), CASCADE_MASK|TK_CONFIG_NULL_OK}, *************** *** 266,289 **** --- 316,357 ---- * active element (if any). */ int activeBorderWidth; /* Width of border around active element. */ int relief; /* 3-d effect: TK_RELIEF_RAISED, etc. */ + #ifdef KANJI + XWSFontSet *fontPtr; + XFontStruct *asciiFontPtr; + XFontStruct *kanjiFontPtr; + #else XFontStruct *fontPtr; /* Text font for menu entries. */ + #endif /* KANJI */ XColor *fg; /* Foreground color for entries. */ + #ifdef KANJI + XWSGC textGC; + #else GC textGC; /* GC for drawing text and other features * of menu entries. */ + #endif /* KANJI */ XColor *disabledFg; /* Foreground color when disabled. NULL * means use normalFg with a 50% stipple * instead. */ Pixmap gray; /* Bitmap for drawing disabled entries in * a stippled fashion. None means not * allocated yet. */ + #ifdef KANJI + XWSGC disabledGC; + #else GC disabledGC; /* Used to produce disabled effect. If * disabledFg isn't NULL, this GC is used to * draw text and icons for disabled entries. * Otherwise text and icons are drawn with * normalGC and this GC is used to stipple * background across them. */ + #endif /* KANJI */ XColor *activeFg; /* Foreground color for active entry. */ + #ifdef KANJI + XWSGC activeGC; + #else GC activeGC; /* GC for drawing active entry. */ + #endif /* KANJI */ XColor *indicatorFg; /* Color for indicators in radio and check * button entries. */ GC indicatorGC; /* For drawing indicators. */ *************** *** 372,379 **** --- 440,454 ---- Tk_Offset(Menu, disabledFg), TK_CONFIG_MONO_ONLY|TK_CONFIG_NULL_OK}, {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL, (char *) NULL, 0, 0}, + #ifdef KANJI + {TK_CONFIG_FONT, "-font", "font", "Font", + DEF_MENU_FONT, Tk_Offset(Menu, asciiFontPtr), 0}, + {TK_CONFIG_FONT, "-kanjifont", "kanjiFont", "KanjiFont", + DEF_MENU_KANJIFONT, Tk_Offset(Menu, kanjiFontPtr), 0}, + #else {TK_CONFIG_FONT, "-font", "font", "Font", DEF_MENU_FONT, Tk_Offset(Menu, fontPtr), 0}, + #endif /* KANJI */ {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground", DEF_MENU_FG, Tk_Offset(Menu, fg), 0}, {TK_CONFIG_STRING, "-postcommand", "postCommand", "Command", *************** *** 521,533 **** --- 596,624 ---- menuPtr->activeBorder = NULL; menuPtr->activeBorderWidth = 0; menuPtr->fontPtr = NULL; + #ifdef KANJI + menuPtr->asciiFontPtr = NULL; + menuPtr->kanjiFontPtr = NULL; + #endif /* KANJI */ menuPtr->fg = NULL; + #ifdef KANJI + menuPtr->textGC = NULL; + #else menuPtr->textGC = None; + #endif /* KANJI */ menuPtr->disabledFg = NULL; menuPtr->gray = None; + #ifdef KANJI + menuPtr->disabledGC = NULL; + #else menuPtr->disabledGC = None; + #endif /* KANJI */ menuPtr->activeFg = NULL; + #ifdef KANJI + menuPtr->activeGC = NULL; + #else menuPtr->activeGC = None; + #endif /* KANJI */ menuPtr->indicatorFg = NULL; menuPtr->indicatorGC = None; menuPtr->indicatorSpace = 0; *************** *** 1034,1051 **** --- 1125,1162 ---- if (menuPtr->entries != NULL) { ckfree((char *) menuPtr->entries); } + #ifdef KANJI + if (menuPtr->fontPtr != NULL ) { + Tk_FreeFontSet(menuPtr->fontPtr); + } + #endif /* KANJI */ + #ifdef KANJI + if (menuPtr->textGC != NULL) { + Tk_FreeGCSet(menuPtr->display, menuPtr->textGC); + } + #else if (menuPtr->textGC != None) { Tk_FreeGC(menuPtr->display, menuPtr->textGC); } + #endif /* KANJI */ if (menuPtr->gray != None) { Tk_FreeBitmap(menuPtr->display, menuPtr->gray); } + #ifdef KANJI + if (menuPtr->disabledGC != NULL) { + Tk_FreeGCSet(menuPtr->display, menuPtr->disabledGC); + } + if (menuPtr->activeGC != NULL) { + Tk_FreeGCSet(menuPtr->display, menuPtr->activeGC); + } + #else if (menuPtr->disabledGC != None) { Tk_FreeGC(menuPtr->display, menuPtr->disabledGC); } if (menuPtr->activeGC != None) { Tk_FreeGC(menuPtr->display, menuPtr->activeGC); } + #endif /* KANJI */ if (menuPtr->indicatorGC != None) { Tk_FreeGC(menuPtr->display, menuPtr->indicatorGC); } *************** *** 1096,1101 **** --- 1207,1228 ---- if (mePtr->image != NULL) { Tk_FreeImage(mePtr->image); } + #ifdef KANJI + if (mePtr->fontPtr != NULL ) { + Tk_FreeFontSet(mePtr->fontPtr); + } + #endif /* KANJI */ + #ifdef KANJI + if (mePtr->textGC != NULL) { + Tk_FreeGCSet(menuPtr->display, mePtr->textGC); + } + if (mePtr->activeGC != NULL) { + Tk_FreeGCSet(menuPtr->display, mePtr->activeGC); + } + if (mePtr->disabledGC != NULL) { + Tk_FreeGCSet(menuPtr->display, mePtr->disabledGC); + } + #else if (mePtr->textGC != None) { Tk_FreeGC(menuPtr->display, mePtr->textGC); } *************** *** 1105,1110 **** --- 1232,1238 ---- if (mePtr->disabledGC != None) { Tk_FreeGC(menuPtr->display, mePtr->disabledGC); } + #endif /* KANJI */ if (mePtr->indicatorGC != None) { Tk_FreeGC(menuPtr->display, mePtr->indicatorGC); } *************** *** 1149,1154 **** --- 1277,1285 ---- { XGCValues gcValues; GC newGC; + #ifdef KANJI + XWSGC newGCSet; + #endif /* KANJI */ unsigned long mask; int i; XSetWindowAttributes atts; *************** *** 1158,1163 **** --- 1289,1298 ---- return TCL_ERROR; } + #ifdef KANJI + menuPtr->fontPtr = Tk_GetFontSet(menuPtr->asciiFontPtr, menuPtr->kanjiFontPtr); + #endif /* KANJI */ + /* * A few options need special processing, such as setting the * background from a 3-D border, or filling in complicated *************** *** 1166,1180 **** --- 1301,1326 ---- Tk_SetBackgroundFromBorder(menuPtr->tkwin, menuPtr->border); + #ifndef KANJI gcValues.font = menuPtr->fontPtr->fid; + #endif /* !KANJI */ gcValues.foreground = menuPtr->fg->pixel; gcValues.background = Tk_3DBorderColor(menuPtr->border)->pixel; + #ifdef KANJI + newGCSet = Tk_GetGCSet(menuPtr->tkwin, GCForeground|GCBackground, + &gcValues, menuPtr->fontPtr); + if (menuPtr->textGC != None) { + Tk_FreeGCSet(menuPtr->display, menuPtr->textGC); + } + menuPtr->textGC = newGCSet; + #else newGC = Tk_GetGC(menuPtr->tkwin, GCForeground|GCBackground|GCFont, &gcValues); if (menuPtr->textGC != None) { Tk_FreeGC(menuPtr->display, menuPtr->textGC); } menuPtr->textGC = newGC; + #endif /* KANJI */ if (menuPtr->disabledFg != NULL) { gcValues.foreground = menuPtr->disabledFg->pixel; *************** *** 1192,1215 **** --- 1338,1384 ---- gcValues.stipple = menuPtr->gray; mask = GCForeground|GCFillStyle|GCStipple; } + #ifdef KANJI + newGCSet = Tk_GetGCSet(menuPtr->tkwin, mask, &gcValues, menuPtr->fontPtr); + if (menuPtr->disabledGC != NULL) { + Tk_FreeGCSet(menuPtr->display, menuPtr->disabledGC); + } + menuPtr->disabledGC = newGCSet; + #else newGC = Tk_GetGC(menuPtr->tkwin, mask, &gcValues); if (menuPtr->disabledGC != None) { Tk_FreeGC(menuPtr->display, menuPtr->disabledGC); } menuPtr->disabledGC = newGC; + #endif /* KANJI */ + #ifndef KANJI gcValues.font = menuPtr->fontPtr->fid; + #endif /* !KANJI */ gcValues.foreground = menuPtr->activeFg->pixel; gcValues.background = Tk_3DBorderColor(menuPtr->activeBorder)->pixel; + #ifdef KANJI + newGCSet = Tk_GetGCSet(menuPtr->tkwin, GCForeground|GCBackground|GCFont, + &gcValues, menuPtr->fontPtr); + if (menuPtr->activeGC != None) { + Tk_FreeGCSet(menuPtr->display, menuPtr->activeGC); + } + menuPtr->activeGC = newGCSet; + #else newGC = Tk_GetGC(menuPtr->tkwin, GCForeground|GCBackground|GCFont, &gcValues); if (menuPtr->activeGC != None) { Tk_FreeGC(menuPtr->display, menuPtr->activeGC); } menuPtr->activeGC = newGC; + #endif /* KANJI */ gcValues.foreground = menuPtr->indicatorFg->pixel; + #ifdef KANJI + newGC = Tk_GetGC(menuPtr->tkwin, GCForeground, &gcValues); + #else newGC = Tk_GetGC(menuPtr->tkwin, GCForeground|GCFont, &gcValues); + #endif /* KANJI */ if (menuPtr->indicatorGC != None) { Tk_FreeGC(menuPtr->display, menuPtr->indicatorGC); } *************** *** 1308,1314 **** --- 1477,1488 ---- * Tk_ConfigureWidget. */ { XGCValues gcValues; + #ifdef KANJI + XWSGC newGCSet, newActiveGC, newDisabledGC; + GC newGC; + #else GC newGC, newActiveGC, newDisabledGC; + #endif /* KANJI */ unsigned long mask; Tk_Image image; *************** *** 1354,1365 **** --- 1528,1547 ---- if (mePtr->label == NULL) { mePtr->labelLength = 0; } else { + #ifdef KANJI + mePtr->labelLength = Tcl_WStrlen(mePtr->label); + #else mePtr->labelLength = strlen(mePtr->label); + #endif /* KANJI */ } if (mePtr->accel == NULL) { mePtr->accelLength = 0; } else { + #ifdef KANJI + mePtr->accelLength = Tcl_WStrlen(mePtr->accel); + #else mePtr->accelLength = strlen(mePtr->accel); + #endif /* KANJI */ } if (mePtr->state == tkActiveUid) { *************** *** 1378,1393 **** --- 1560,1587 ---- } } + #ifdef KANJI + if ((mePtr->asciiFontPtr != NULL) || (mePtr->kanjiFontPtr != NULL) + || (mePtr->border != NULL) + || (mePtr->fg != NULL) || (mePtr->activeBorder != NULL) + || (mePtr->activeFg != NULL)) { + mePtr->fontPtr = Tk_GetFontSet( + (mePtr->asciiFontPtr != NULL) ? mePtr->asciiFontPtr : menuPtr->asciiFontPtr, + (mePtr->kanjiFontPtr != NULL) ? mePtr->kanjiFontPtr : menuPtr->kanjiFontPtr); + #else if ((mePtr->fontPtr != NULL) || (mePtr->border != NULL) || (mePtr->fg != NULL) || (mePtr->activeBorder != NULL) || (mePtr->activeFg != NULL)) { + #endif /* KANJI */ gcValues.foreground = (mePtr->fg != NULL) ? mePtr->fg->pixel : menuPtr->fg->pixel; gcValues.background = Tk_3DBorderColor( (mePtr->border != NULL) ? mePtr->border : menuPtr->border) ->pixel; + #ifndef KANJI gcValues.font = (mePtr->fontPtr != NULL) ? mePtr->fontPtr->fid : menuPtr->fontPtr->fid; + #endif /* !KANJI */ /* * Note: disable GraphicsExpose events; we know there won't be *************** *** 1396,1405 **** --- 1590,1606 ---- */ gcValues.graphics_exposures = False; + #ifdef KANJI + newGCSet = Tk_GetGCSet(menuPtr->tkwin, + GCForeground|GCBackground|GCFont|GCGraphicsExposures, + &gcValues, mePtr->fontPtr); + + #else newGC = Tk_GetGC(menuPtr->tkwin, GCForeground|GCBackground|GCFont|GCGraphicsExposures, &gcValues); + #endif /* KANJI */ if (menuPtr->disabledFg != NULL) { gcValues.foreground = menuPtr->disabledFg->pixel; mask = GCForeground|GCBackground|GCFont|GCGraphicsExposures; *************** *** 1409,1429 **** --- 1610,1655 ---- gcValues.stipple = menuPtr->gray; mask = GCForeground|GCFillStyle|GCStipple; } + #ifdef KANJI + newDisabledGC = Tk_GetGCSet(menuPtr->tkwin, mask, &gcValues, mePtr->fontPtr); + #else newDisabledGC = Tk_GetGC(menuPtr->tkwin, mask, &gcValues); + #endif /* KANJI */ gcValues.foreground = (mePtr->activeFg != NULL) ? mePtr->activeFg->pixel : menuPtr->activeFg->pixel; gcValues.background = Tk_3DBorderColor( (mePtr->activeBorder != NULL) ? mePtr->activeBorder : menuPtr->activeBorder)->pixel; + #ifdef KANJI + newActiveGC = Tk_GetGCSet(menuPtr->tkwin, + GCForeground|GCBackground|GCFont|GCGraphicsExposures, + &gcValues, mePtr->fontPtr); + #else newActiveGC = Tk_GetGC(menuPtr->tkwin, GCForeground|GCBackground|GCFont|GCGraphicsExposures, &gcValues); + #endif /* KANJI */ } else { + #ifdef KANJI + newGCSet = NULL; + newActiveGC = NULL; + newDisabledGC = NULL; + #else newGC = None; newActiveGC = None; newDisabledGC = None; + #endif /* KANJI */ + } + #ifdef KANJI + if (mePtr->textGC != NULL) { + Tk_FreeGCSet(menuPtr->display, mePtr->textGC); + } + mePtr->textGC = newGCSet; + if (mePtr->activeGC != NULL) { + Tk_FreeGCSet(menuPtr->display, mePtr->activeGC); } + #else if (mePtr->textGC != None) { Tk_FreeGC(menuPtr->display, mePtr->textGC); } *************** *** 1431,1440 **** --- 1657,1673 ---- if (mePtr->activeGC != None) { Tk_FreeGC(menuPtr->display, mePtr->activeGC); } + #endif /* KANJI */ mePtr->activeGC = newActiveGC; + #ifdef KANJI + if (mePtr->disabledGC != NULL) { + Tk_FreeGCSet(menuPtr->display, mePtr->disabledGC); + } + #else if (mePtr->disabledGC != None) { Tk_FreeGC(menuPtr->display, mePtr->disabledGC); } + #endif /* KANJI */ mePtr->disabledGC = newDisabledGC; if (mePtr->indicatorFg != NULL) { gcValues.foreground = mePtr->indicatorFg->pixel; *************** *** 1452,1464 **** --- 1685,1708 ---- char *value; if (mePtr->name == NULL) { + #ifdef KANJI + mePtr->name = ckalloc((unsigned) (mePtr->labelLength * sizeof(wchar) + 1)); + strcpy(mePtr->name, (mePtr->label == NULL) ? "" : Tk_DecodeWStr(mePtr->label)); + #else mePtr->name = (char *) ckalloc((unsigned) (mePtr->labelLength + 1)); strcpy(mePtr->name, (mePtr->label == NULL) ? "" : mePtr->label); + #endif /* KANJI */ } if (mePtr->onValue == NULL) { + #ifdef KANJI + mePtr->onValue = ckalloc((unsigned) + (mePtr->labelLength * sizeof(wchar) + 1)); + strcpy(mePtr->onValue, (mePtr->label == NULL) ? "" : Tk_DecodeWStr(mePtr->label)); + #else mePtr->onValue = (char *) ckalloc((unsigned) (mePtr->labelLength + 1)); strcpy(mePtr->onValue, (mePtr->label == NULL) ? "" : mePtr->label); + #endif /* KANJI */ } /* *************** *** 1551,1557 **** --- 1795,1805 ---- { Menu *menuPtr = (Menu *) clientData; register MenuEntry *mePtr; + #ifdef KANJI + XWSFontSet *fontPtr; + #else XFontStruct *fontPtr; + #endif /* KANJI */ int maxLabelWidth, maxIndicatorWidth, maxAccelWidth; int width, height, indicatorSpace; int i, y; *************** *** 1721,1729 **** --- 1969,1985 ---- register MenuEntry *mePtr; register Tk_Window tkwin = menuPtr->tkwin; Tk_3DBorder bgBorder, activeBorder; + #ifdef KANJI + XWSFontSet *fontPtr; + #else XFontStruct *fontPtr; + #endif /* KANJI */ int index, baseline, strictMotif, leftEdge, y, height; + #ifdef KANJI + XWSGC gc; + #else GC gc; + #endif /* KANJI */ XPoint points[3]; menuPtr->flags &= ~REDRAW_PENDING; *************** *** 1827,1833 **** --- 2083,2093 ---- Tk_SizeOfBitmap(menuPtr->display, mePtr->bitmap, &width, &height); XCopyPlane(menuPtr->display, mePtr->bitmap, Tk_WindowId(tkwin), + #ifdef KANJI + gc->fe[0].gc, 0, 0, (unsigned) width, (unsigned) height, leftEdge, + #else gc, 0, 0, (unsigned) width, (unsigned) height, leftEdge, + #endif /* KANJI */ (int) (mePtr->y + (mePtr->height - height)/2), 1); } else { baseline = mePtr->y + (mePtr->height + fontPtr->ascent *************** *** 1874,1879 **** --- 2134,2142 ---- * Draw check-button indicator. */ + #ifdef KANJI + { GC gc; + #endif /* KANJI */ gc = mePtr->indicatorGC; if (gc == None) { gc = menuPtr->indicatorGC; *************** *** 1927,1932 **** --- 2190,2198 ---- menuPtr->border, points, 4, DECORATION_BORDER_WIDTH, TK_RELIEF_SUNKEN); } + #ifdef KANJI + } + #endif /* KANJI */ /* * Draw separator. *************** *** 1978,1984 **** --- 2244,2254 ---- if ((mePtr->state == tkDisabledUid) && (menuPtr->disabledFg == NULL)) { XFillRectangle(menuPtr->display, Tk_WindowId(tkwin), + #ifdef KANJI + menuPtr->disabledGC->fe[0].gc, menuPtr->borderWidth, + #else menuPtr->disabledGC, menuPtr->borderWidth, + #endif /* KANJI */ mePtr->y, (unsigned) (Tk_Width(tkwin) - 2*menuPtr->borderWidth), (unsigned) mePtr->height); *************** *** 2097,2108 **** --- 2367,2388 ---- for (i = 0; i < menuPtr->numEntries; i++) { char *label; + #ifdef KANJI + if (menuPtr->entries[i]->label != NULL ) { + label = Tk_DecodeWStr(menuPtr->entries[i]->label); + if (Tcl_StringMatch(label, string)) { + *indexPtr = i; + return TCL_OK; + } + } + #else label = menuPtr->entries[i]->label; if ((label != NULL) && (Tcl_StringMatch(menuPtr->entries[i]->label, string))) { *indexPtr = i; return TCL_OK; } + #endif /* KANJI */ } Tcl_AppendResult(interp, "bad menu entry index \"", *************** *** 2261,2269 **** --- 2541,2559 ---- mePtr->activeBorder = NULL; mePtr->activeFg = NULL; mePtr->fontPtr = NULL; + #ifdef KANJI + mePtr->asciiFontPtr = NULL; + mePtr->kanjiFontPtr = NULL; + #endif /* KANJI */ + #ifdef KANJI + mePtr->textGC = NULL; + mePtr->activeGC = NULL; + mePtr->disabledGC = NULL; + #else mePtr->textGC = None; mePtr->activeGC = None; mePtr->disabledGC = None; + #endif /* KANJI */ mePtr->indicatorOn = 1; mePtr->indicatorFg = NULL; mePtr->indicatorGC = None; diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/generic/tkMenubutton.c ./generic/tkMenubutton.c *** ../tk4.2/generic/tkMenubutton.c Tue Aug 27 02:09:42 1996 --- ./generic/tkMenubutton.c Fri Oct 18 13:14:51 1996 *************** *** 39,46 **** --- 39,50 ---- * Information about what's displayed in the menu button: */ + #ifdef KANJI + wchar *text; + #else char *text; /* Text to display in button (malloc'ed) * or NULL. */ + #endif /* KANJI */ int numChars; /* # of characters in text. */ int underline; /* Index of character to underline. */ char *textVarName; /* Name of variable (malloc'ed) or NULL. *************** *** 83,106 **** --- 87,125 ---- * Indicates how much interior stuff must * be offset from outside edges to leave * room for borders. */ + #ifdef KANJI + XWSFontSet *fontPtr; + XFontStruct *asciiFontPtr; + XFontStruct *kanjiFontPtr; + #else XFontStruct *fontPtr; /* Information about text font, or NULL. */ + #endif /* KANJI */ XColor *normalFg; /* Foreground color in normal mode. */ XColor *activeFg; /* Foreground color in active mode. NULL * means use normalFg instead. */ XColor *disabledFg; /* Foreground color when disabled. NULL * means use normalFg with a 50% stipple * instead. */ + #ifdef KANJI + XWSGC normalTextGC; + XWSGC activeTextGC; + #else GC normalTextGC; /* GC for drawing text in normal mode. */ GC activeTextGC; /* GC for drawing text in active mode (NULL * means use normalTextGC). */ + #endif /* KANJI */ Pixmap gray; /* Pixmap for displaying disabled text/icon if * disabledFg is NULL. */ + #ifdef KANJI + XWSGC disabledGC; + #else GC disabledGC; /* Used to produce disabled effect. If * disabledFg isn't NULL, this GC is used to * draw button text or icon. Otherwise * text or icon is drawn with normalGC and * this GC is used to stipple background * across it. */ + #endif /* KANJI */ int leftBearing; /* Distance from text origin to leftmost drawn * pixel (positive means to right). */ int rightBearing; /* Amount text sticks right from its origin. */ *************** *** 217,224 **** --- 236,250 ---- TK_CONFIG_MONO_ONLY|TK_CONFIG_NULL_OK}, {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL, (char *) NULL, 0, 0}, + #ifdef KANJI + {TK_CONFIG_FONT, "-font", "font", "Font", + DEF_MENUBUTTON_FONT, Tk_Offset(MenuButton, asciiFontPtr), 0}, + {TK_CONFIG_FONT, "-kanjifont", "kanjiFont", "KanjiFont", + DEF_MENUBUTTON_KANJIFONT, Tk_Offset(MenuButton, kanjiFontPtr), 0}, + #else {TK_CONFIG_FONT, "-font", "font", "Font", DEF_MENUBUTTON_FONT, Tk_Offset(MenuButton, fontPtr), 0}, + #endif /* KANJI */ {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground", DEF_MENUBUTTON_FG, Tk_Offset(MenuButton, normalFg), 0}, {TK_CONFIG_STRING, "-height", "height", "Height", *************** *** 252,259 **** --- 278,290 ---- {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus", DEF_MENUBUTTON_TAKE_FOCUS, Tk_Offset(MenuButton, takeFocus), TK_CONFIG_NULL_OK}, + #ifdef KANJI + {TK_CONFIG_WSTRING, "-text", "text", "Text", + DEF_MENUBUTTON_TEXT, Tk_Offset(MenuButton, text), 0}, + #else {TK_CONFIG_STRING, "-text", "text", "Text", DEF_MENUBUTTON_TEXT, Tk_Offset(MenuButton, text), 0}, + #endif /* KANJI */ {TK_CONFIG_STRING, "-textvariable", "textVariable", "Variable", DEF_MENUBUTTON_TEXT_VARIABLE, Tk_Offset(MenuButton, textVarName), TK_CONFIG_NULL_OK}, *************** *** 364,376 **** --- 395,420 ---- mbPtr->highlightColorPtr = NULL; mbPtr->inset = 0; mbPtr->fontPtr = NULL; + #ifdef KANJI + mbPtr->asciiFontPtr = NULL; + mbPtr->kanjiFontPtr = NULL; + #endif /* KANJI */ mbPtr->normalFg = NULL; mbPtr->activeFg = NULL; mbPtr->disabledFg = NULL; + #ifdef KANJI + mbPtr->normalTextGC = NULL; + mbPtr->activeTextGC = NULL; + #else mbPtr->normalTextGC = None; mbPtr->activeTextGC = None; + #endif /* KANJI */ mbPtr->gray = None; + #ifdef KANJI + mbPtr->disabledGC = NULL; + #else mbPtr->disabledGC = None; + #endif /* KANJI */ mbPtr->leftBearing = 0; mbPtr->rightBearing = 0; mbPtr->widthString = NULL; *************** *** 515,532 **** --- 559,596 ---- if (mbPtr->image != NULL) { Tk_FreeImage(mbPtr->image); } + #ifdef KANJI + if (mbPtr->fontPtr != NULL ) { + Tk_FreeFontSet(mbPtr->fontPtr); + } + #endif /* KANJI */ + #ifdef KANJI + if (mbPtr->normalTextGC != NULL) { + Tk_FreeGCSet(mbPtr->display, mbPtr->normalTextGC); + } + if (mbPtr->activeTextGC != NULL) { + Tk_FreeGCSet(mbPtr->display, mbPtr->activeTextGC); + } + #else if (mbPtr->normalTextGC != None) { Tk_FreeGC(mbPtr->display, mbPtr->normalTextGC); } if (mbPtr->activeTextGC != None) { Tk_FreeGC(mbPtr->display, mbPtr->activeTextGC); } + #endif /* KANJI */ if (mbPtr->gray != None) { Tk_FreeBitmap(mbPtr->display, mbPtr->gray); } + #ifdef KANJI + if (mbPtr->disabledGC != NULL) { + Tk_FreeGCSet(mbPtr->display, mbPtr->disabledGC); + } + #else if (mbPtr->disabledGC != None) { Tk_FreeGC(mbPtr->display, mbPtr->disabledGC); } + #endif /* KANJI */ Tk_FreeOptions(configSpecs, (char *) mbPtr, mbPtr->display, 0); ckfree((char *) mbPtr); } *************** *** 562,567 **** --- 626,634 ---- int flags; /* Flags to pass to Tk_ConfigureWidget. */ { XGCValues gcValues; + #ifdef KANJI + XWSGC newGCSet; + #endif /* KANJI */ GC newGC; unsigned long mask; int result; *************** *** 583,588 **** --- 650,659 ---- return TCL_ERROR; } + #ifdef KANJI + mbPtr->fontPtr = Tk_GetFontSet(mbPtr->asciiFontPtr, mbPtr->kanjiFontPtr); + #endif /* KANJI */ + /* * A few options need special processing, such as setting the * background from a 3-D border, or filling in complicated *************** *** 606,612 **** --- 677,685 ---- mbPtr->highlightWidth = 0; } + #ifndef KANJI gcValues.font = mbPtr->fontPtr->fid; + #endif /* !KANJI */ gcValues.foreground = mbPtr->normalFg->pixel; gcValues.background = Tk_3DBorderColor(mbPtr->normalBorder)->pixel; *************** *** 617,644 **** --- 690,744 ---- */ gcValues.graphics_exposures = False; + #ifdef KANJI + newGCSet = Tk_GetGCSet(mbPtr->tkwin, + GCForeground|GCBackground|GCGraphicsExposures, &gcValues, + mbPtr->fontPtr); + if (mbPtr->normalTextGC != NULL) { + Tk_FreeGCSet(mbPtr->display, mbPtr->normalTextGC); + } + mbPtr->normalTextGC = newGCSet; + #else newGC = Tk_GetGC(mbPtr->tkwin, GCForeground|GCBackground|GCFont|GCGraphicsExposures, &gcValues); if (mbPtr->normalTextGC != None) { Tk_FreeGC(mbPtr->display, mbPtr->normalTextGC); } mbPtr->normalTextGC = newGC; + #endif /* KANJI */ + #ifndef KANJI gcValues.font = mbPtr->fontPtr->fid; + #endif /* !KANJI */ gcValues.foreground = mbPtr->activeFg->pixel; gcValues.background = Tk_3DBorderColor(mbPtr->activeBorder)->pixel; + #ifdef KANJI + newGCSet = Tk_GetGCSet(mbPtr->tkwin, GCForeground|GCBackground, + &gcValues, mbPtr->fontPtr); + if (mbPtr->activeTextGC != NULL) { + Tk_FreeGCSet(mbPtr->display, mbPtr->activeTextGC); + } + mbPtr->activeTextGC = newGCSet; + #else newGC = Tk_GetGC(mbPtr->tkwin, GCForeground|GCBackground|GCFont, &gcValues); if (mbPtr->activeTextGC != None) { Tk_FreeGC(mbPtr->display, mbPtr->activeTextGC); } mbPtr->activeTextGC = newGC; + #endif /* KANJI */ + #ifndef KANJI gcValues.font = mbPtr->fontPtr->fid; + #endif /* !KANJI */ gcValues.background = Tk_3DBorderColor(mbPtr->normalBorder)->pixel; if ((mbPtr->disabledFg != NULL) && (mbPtr->imageString == NULL)) { gcValues.foreground = mbPtr->disabledFg->pixel; + #ifdef KANJI + mask = GCForeground|GCBackground; + #else mask = GCForeground|GCBackground|GCFont; + #endif /* KANJI */ } else { gcValues.foreground = gcValues.background; if (mbPtr->gray == None) { *************** *** 652,662 **** --- 752,770 ---- gcValues.stipple = mbPtr->gray; mask = GCForeground|GCFillStyle|GCStipple; } + #ifdef KANJI + newGCSet = Tk_GetGCSet(mbPtr->tkwin, mask, &gcValues, mbPtr->fontPtr); + if (mbPtr->disabledGC != NULL) { + Tk_FreeGCSet(mbPtr->display, mbPtr->disabledGC); + } + mbPtr->disabledGC = newGCSet; + #else newGC = Tk_GetGC(mbPtr->tkwin, mask, &gcValues); if (mbPtr->disabledGC != None) { Tk_FreeGC(mbPtr->display, mbPtr->disabledGC); } mbPtr->disabledGC = newGC; + #endif /* KANJI */ if (mbPtr->padX < 0) { mbPtr->padX = 0; *************** *** 695,700 **** --- 803,821 ---- char *value; value = Tcl_GetVar(interp, mbPtr->textVarName, TCL_GLOBAL_ONLY); + #ifdef KANJI + if (value == NULL) { + Tcl_SetVar(interp, mbPtr->textVarName, Tk_DecodeWStr(mbPtr->text), + TCL_GLOBAL_ONLY); + } else { + wchar *old = mbPtr->text; + + mbPtr->text = Tk_GetWStr(interp, value); + if (old != NULL) { + Tk_FreeWStr(old); + } + } + #else if (value == NULL) { Tcl_SetVar(interp, mbPtr->textVarName, mbPtr->text, TCL_GLOBAL_ONLY); *************** *** 705,710 **** --- 826,832 ---- mbPtr->text = (char *) ckalloc((unsigned) (strlen(value) + 1)); strcpy(mbPtr->text, value); } + #endif /* KANJI */ Tcl_TraceVar(interp, mbPtr->textVarName, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, MenuButtonTextVarProc, (ClientData) mbPtr); *************** *** 773,779 **** --- 895,905 ---- ClientData clientData; /* Information about widget. */ { register MenuButton *mbPtr = (MenuButton *) clientData; + #ifdef KANJI + XWSGC gc; + #else GC gc; + #endif /* KANJI */ Tk_3DBorder border; Pixmap pixmap; int x = 0; /* Initialization needed only to stop *************** *** 847,853 **** --- 973,983 ---- x, y); } else { XCopyPlane(mbPtr->display, mbPtr->bitmap, pixmap, + #ifdef KANJI + gc->fe[0].gc, 0, 0, (unsigned) width, (unsigned) height, x, y, 1); + #else gc, 0, 0, (unsigned) width, (unsigned) height, x, y, 1); + #endif /* KANJI */ } } else if (mbPtr->bitmap != None) { Tk_SizeOfBitmap(mbPtr->display, mbPtr->bitmap, &width, &height); *************** *** 879,887 **** --- 1009,1023 ---- y = Tk_Height(tkwin) - mbPtr->inset - mbPtr->padY - height; break; } + #ifdef KANJI + TkWSDisplayText(mbPtr->display, pixmap, mbPtr->fontPtr, + mbPtr->text, mbPtr->numChars, x, y, mbPtr->textWidth, + mbPtr->justify, mbPtr->underline, gc); + #else TkDisplayText(mbPtr->display, pixmap, mbPtr->fontPtr, mbPtr->text, mbPtr->numChars, x, y, mbPtr->textWidth, mbPtr->justify, mbPtr->underline, gc); + #endif /* KANJI */ } /* *************** *** 891,897 **** --- 1027,1037 ---- if ((mbPtr->state == tkDisabledUid) && ((mbPtr->disabledFg == NULL) || (mbPtr->image != NULL))) { + #ifdef KANJI + XFillRectangle(mbPtr->display, pixmap, mbPtr->disabledGC->fe[0].gc, + #else XFillRectangle(mbPtr->display, pixmap, mbPtr->disabledGC, + #endif /* KANJI */ mbPtr->inset, mbPtr->inset, (unsigned) (Tk_Width(tkwin) - 2*mbPtr->inset), (unsigned) (Tk_Height(tkwin) - 2*mbPtr->inset)); *************** *** 946,954 **** --- 1086,1100 ---- * then delete the pixmap. */ + #ifdef KANJI + XCopyArea(mbPtr->display, pixmap, Tk_WindowId(tkwin), + mbPtr->normalTextGC->fe[0].gc, 0, 0, (unsigned) Tk_Width(tkwin), + (unsigned) Tk_Height(tkwin), 0, 0); + #else XCopyArea(mbPtr->display, pixmap, Tk_WindowId(tkwin), mbPtr->normalTextGC, 0, 0, (unsigned) Tk_Width(tkwin), (unsigned) Tk_Height(tkwin), 0, 0); + #endif /* KANJI */ Tk_FreePixmap(mbPtr->display, pixmap); } *************** *** 1099,1112 **** --- 1245,1269 ---- height = mbPtr->height; } } else { + #ifdef KANJI + mbPtr->numChars = Tcl_WStrlen(mbPtr->text); + TkWSComputeTextGeometry(mbPtr->fontPtr, mbPtr->text, + mbPtr->numChars, mbPtr->wrapLength, &mbPtr->textWidth, + &mbPtr->textHeight); + #else mbPtr->numChars = strlen(mbPtr->text); TkComputeTextGeometry(mbPtr->fontPtr, mbPtr->text, mbPtr->numChars, mbPtr->wrapLength, &mbPtr->textWidth, &mbPtr->textHeight); + #endif /* KANJI */ width = mbPtr->textWidth; height = mbPtr->textHeight; if (mbPtr->width > 0) { + #ifdef KANJI + width = mbPtr->width * XTextWidth(mbPtr->asciiFontPtr, "0", 1); + #else width = mbPtr->width * XTextWidth(mbPtr->fontPtr, "0", 1); + #endif /* KANJI */ } if (mbPtr->height > 0) { height = mbPtr->height * (mbPtr->fontPtr->ascent *************** *** 1162,1167 **** --- 1319,1327 ---- { register MenuButton *mbPtr = (MenuButton *) clientData; char *value; + #ifdef KANJI + wchar *old = mbPtr->text; + #endif /* KANJI */ /* * If the variable is unset, then immediately recreate it unless *************** *** 1170,1177 **** --- 1330,1342 ---- if (flags & TCL_TRACE_UNSETS) { if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) { + #ifdef KANJI + Tcl_SetVar(interp, mbPtr->textVarName, + Tk_DecodeWStr(mbPtr->text), TCL_GLOBAL_ONLY); + #else Tcl_SetVar(interp, mbPtr->textVarName, mbPtr->text, TCL_GLOBAL_ONLY); + #endif /* KANJI */ Tcl_TraceVar(interp, mbPtr->textVarName, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, MenuButtonTextVarProc, clientData); *************** *** 1183,1193 **** --- 1348,1365 ---- if (value == NULL) { value = ""; } + #ifdef KANJI + mbPtr->text = Tk_GetWStr(interp, value); + if (old != NULL ) { + Tk_FreeWStr(old); + } + #else if (mbPtr->text != NULL) { ckfree(mbPtr->text); } mbPtr->text = (char *) ckalloc((unsigned) (strlen(value) + 1)); strcpy(mbPtr->text, value); + #endif /* KANJI */ ComputeMenuButtonGeometry(mbPtr); if ((mbPtr->tkwin != NULL) && Tk_IsMapped(mbPtr->tkwin) diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/generic/tkMessage.c ./generic/tkMessage.c *** ../tk4.2/generic/tkMessage.c Tue Aug 27 02:09:42 1996 --- ./generic/tkMessage.c Fri Oct 18 13:14:52 1996 *************** *** 18,23 **** --- 18,28 ---- #include "default.h" #include "tkInt.h" + #ifdef KANJI + #define TkMeasureChars TkMeasureWChars + #define TkDisplayChars TkDisplayWChars + #endif /* KANJI */ + /* * A data structure of the following type is kept for each message * widget managed by this file: *************** *** 33,39 **** --- 38,48 ---- * freed even after tkwin has gone away. */ Tcl_Interp *interp; /* Interpreter associated with message. */ Tcl_Command widgetCmd; /* Token for message's widget command. */ + #ifdef KANJI + wchar *string; /* String displayed in message. */ + #else Tk_Uid string; /* String displayed in message. */ + #endif /* KANJI */ int numChars; /* Number of characters in string, not * including terminating NULL character. */ char *textVarName; /* Name of variable (malloc'ed) or NULL. *************** *** 61,69 **** --- 70,88 ---- * Indicates how much interior stuff must * be offset from outside edges to leave * room for borders. */ + #ifdef KANJI + XWSFontSet *fontPtr; /* Information about text font, or NULL. */ + XFontStruct *asciiFontPtr; /* Information about ascii text font, or NULL. */ + XFontStruct *kanjiFontPtr; /* Information about kanji text font, or NULL. */ + #else XFontStruct *fontPtr; /* Information about text font, or NULL. */ + #endif /* KANJI */ XColor *fgColorPtr; /* Foreground color in normal mode. */ + #ifdef KANJI + XWSGC textGC; /* GCSet for drawing text in normal mode. */ + #else GC textGC; /* GC for drawing text in normal mode. */ + #endif /* KANJI */ int padX, padY; /* User-requested extra space around text. */ Tk_Anchor anchor; /* Where to position text within window region * if window is larger or smaller than *************** *** 128,135 **** --- 147,161 ---- DEF_MESSAGE_CURSOR, Tk_Offset(Message, cursor), TK_CONFIG_NULL_OK}, {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL, (char *) NULL, 0, 0}, + #ifdef KANJI + {TK_CONFIG_FONT, "-font", "font", "Font", + DEF_MESSAGE_FONT, Tk_Offset(Message, asciiFontPtr), 0}, + {TK_CONFIG_FONT, "-kanjifont", "kanjiFont", "KanjiFont", + DEF_MESSAGE_KANJIFONT, Tk_Offset(Message, kanjiFontPtr), 0}, + #else {TK_CONFIG_FONT, "-font", "font", "Font", DEF_MESSAGE_FONT, Tk_Offset(Message, fontPtr), 0}, + #endif /* KANJI */ {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground", DEF_MESSAGE_FG, Tk_Offset(Message, fgColorPtr), 0}, {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground", *************** *** 151,158 **** --- 177,189 ---- {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus", DEF_MESSAGE_TAKE_FOCUS, Tk_Offset(Message, takeFocus), TK_CONFIG_NULL_OK}, + #ifdef KANJI + {TK_CONFIG_WSTRING, "-text", "text", "Text", + DEF_MESSAGE_TEXT, Tk_Offset(Message, string), 0}, + #else {TK_CONFIG_STRING, "-text", "text", "Text", DEF_MESSAGE_TEXT, Tk_Offset(Message, string), 0}, + #endif /* KANJI */ {TK_CONFIG_STRING, "-textvariable", "textVariable", "Variable", DEF_MESSAGE_TEXT_VARIABLE, Tk_Offset(Message, textVarName), TK_CONFIG_NULL_OK}, *************** *** 240,247 **** --- 271,286 ---- msgPtr->highlightColorPtr = NULL; msgPtr->inset = 0; msgPtr->fontPtr = NULL; + #ifdef KANJI + msgPtr->asciiFontPtr = NULL; + msgPtr->kanjiFontPtr = NULL; + #endif /* KANJI */ msgPtr->fgColorPtr = NULL; + #ifdef KANJI + msgPtr->textGC = NULL; + #else msgPtr->textGC = None; + #endif /* KANJI */ msgPtr->padX = 0; msgPtr->padY = 0; msgPtr->anchor = TK_ANCHOR_CENTER; *************** *** 370,378 **** --- 409,428 ---- TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, MessageTextVarProc, (ClientData) msgPtr); } + #ifdef KANJI + if (msgPtr->fontPtr != NULL ) { + Tk_FreeFontSet(msgPtr->fontPtr); + } + #endif /* KANJI */ + #ifdef KANJI + if (msgPtr->textGC != NULL) { + Tk_FreeGCSet(msgPtr->display, msgPtr->textGC); + } + #else if (msgPtr->textGC != None) { Tk_FreeGC(msgPtr->display, msgPtr->textGC); } + #endif /* KANJI */ Tk_FreeOptions(configSpecs, (char *) msgPtr, msgPtr->display, 0); ckfree((char *) msgPtr); } *************** *** 408,413 **** --- 458,466 ---- int flags; /* Flags to pass to Tk_ConfigureWidget. */ { XGCValues gcValues; + #ifdef KANJI + XWSGC newGCSet; + #endif /* KANJI */ GC newGC; /* *************** *** 425,430 **** --- 478,487 ---- return TCL_ERROR; } + #ifdef KANJI + msgPtr->fontPtr = Tk_GetFontSet(msgPtr->asciiFontPtr, msgPtr->kanjiFontPtr); + #endif /* KANJI */ + /* * If the message is to display the value of a variable, then set up * a trace on the variable's value, create the variable if it doesn't *************** *** 435,440 **** --- 492,510 ---- char *value; value = Tcl_GetVar(interp, msgPtr->textVarName, TCL_GLOBAL_ONLY); + #ifdef KANJI + if (value == NULL) { + Tcl_SetVar(interp, msgPtr->textVarName, Tk_DecodeWStr(msgPtr->string), + TCL_GLOBAL_ONLY); + } else { + wchar *old = msgPtr->string; + + msgPtr->string = Tk_GetWStr(interp, value); + if (old != NULL) { + Tk_FreeWStr(old); + } + } + #else if (value == NULL) { Tcl_SetVar(interp, msgPtr->textVarName, msgPtr->string, TCL_GLOBAL_ONLY); *************** *** 445,450 **** --- 515,521 ---- msgPtr->string = (char *) ckalloc((unsigned) (strlen(value) + 1)); strcpy(msgPtr->string, value); } + #endif /* KANJI */ Tcl_TraceVar(interp, msgPtr->textVarName, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, MessageTextVarProc, (ClientData) msgPtr); *************** *** 456,462 **** --- 527,537 ---- * that couldn't be specified to Tk_ConfigureWidget. */ + #ifdef KANJI + msgPtr->numChars = Tcl_WStrlen(msgPtr->string); + #else msgPtr->numChars = strlen(msgPtr->string); + #endif /* KANJI */ Tk_SetBackgroundFromBorder(msgPtr->tkwin, msgPtr->border); *************** *** 464,469 **** --- 539,553 ---- msgPtr->highlightWidth = 0; } + #ifdef KANJI + gcValues.foreground = msgPtr->fgColorPtr->pixel; + newGCSet = Tk_GetGCSet(msgPtr->tkwin, GCForeground|GCFont, + &gcValues, msgPtr->fontPtr); + if (msgPtr->textGC != NULL) { + Tk_FreeGCSet(msgPtr->display, msgPtr->textGC); + } + msgPtr->textGC = newGCSet; + #else gcValues.font = msgPtr->fontPtr->fid; gcValues.foreground = msgPtr->fgColorPtr->pixel; newGC = Tk_GetGC(msgPtr->tkwin, GCForeground|GCFont, *************** *** 472,477 **** --- 556,562 ---- Tk_FreeGC(msgPtr->display, msgPtr->textGC); } msgPtr->textGC = newGC; + #endif /* KANJI */ if (msgPtr->padX == -1) { msgPtr->padX = msgPtr->fontPtr->ascent/2; *************** *** 519,525 **** --- 604,614 ---- ComputeMessageGeometry(msgPtr) register Message *msgPtr; /* Information about window. */ { + #ifdef KANJI + wchar *p; + #else char *p; + #endif /* KANJI */ int width, inc, height, numLines; int thisWidth, maxWidth; int aspect, lowerBound, upperBound; *************** *** 575,581 **** --- 664,674 ---- * they follow a user-requested newline. */ + #ifdef KANJI + while (ISWSPACE(*p)) { + #else while (isspace(UCHAR(*p))) { + #endif /* KANJI */ if (*p == '\n') { p++; break; *************** *** 629,635 **** --- 722,732 ---- { register Message *msgPtr = (Message *) clientData; register Tk_Window tkwin = msgPtr->tkwin; + #ifdef KANJI + wchar *p; + #else char *p; + #endif /* KANJI */ int x, y, lineLength, numChars, charsLeft; msgPtr->flags &= ~REDRAW_PENDING; *************** *** 702,708 **** --- 799,809 ---- * a user-requested newline. */ + #ifdef KANJI + while (ISWSPACE(*p)) { + #else while (isspace(UCHAR(*p))) { + #endif /* KANJI */ charsLeft--; if (*p == '\n') { p++; *************** *** 861,866 **** --- 962,970 ---- { register Message *msgPtr = (Message *) clientData; char *value; + #ifdef KANJI + wchar *old = msgPtr->string; + #endif /* KANJI * / /* * If the variable is unset, then immediately recreate it unless *************** *** 869,876 **** --- 973,985 ---- if (flags & TCL_TRACE_UNSETS) { if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) { + #ifdef KANJI + Tcl_SetVar(interp, msgPtr->textVarName, + Tk_DecodeWStr(msgPtr->string), TCL_GLOBAL_ONLY); + #else Tcl_SetVar(interp, msgPtr->textVarName, msgPtr->string, TCL_GLOBAL_ONLY); + #endif /* KANJI */ Tcl_TraceVar(interp, msgPtr->textVarName, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, MessageTextVarProc, clientData); *************** *** 882,893 **** --- 991,1010 ---- if (value == NULL) { value = ""; } + #ifdef KANJI + msgPtr->string = Tk_GetWStr(interp, value); + msgPtr->numChars = Tcl_WStrlen(msgPtr->string); + if (old != NULL) { + Tk_FreeWStr(old); + } + #else if (msgPtr->string != NULL) { ckfree(msgPtr->string); } msgPtr->numChars = strlen(value); msgPtr->string = (char *) ckalloc((unsigned) (msgPtr->numChars + 1)); strcpy(msgPtr->string, value); + #endif /* KANJI */ ComputeMessageGeometry(msgPtr); if ((msgPtr->tkwin != NULL) && Tk_IsMapped(msgPtr->tkwin) diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/generic/tkScale.c ./generic/tkScale.c *** ../tk4.2/generic/tkScale.c Tue Aug 27 02:09:43 1996 --- ./generic/tkScale.c Fri Oct 18 13:14:53 1996 *************** *** 76,84 **** --- 76,88 ---- int repeatDelay; /* How long to wait before auto-repeating * on scrolling actions (in ms). */ int repeatInterval; /* Interval between autorepeats (in ms). */ + #ifdef KANJI + wchar *label; + #else char *label; /* Label to display above or to right of * scale; NULL means don't display a * label. Malloc'ed. */ + #endif /* KANJI */ int labelLength; /* Number of non-NULL chars. in label. */ Tk_Uid state; /* Normal or disabled. Value cannot be * changed when scale is disabled. */ *************** *** 95,103 **** --- 99,117 ---- XColor *troughColorPtr; /* Color for drawing trough. */ GC troughGC; /* For drawing trough. */ GC copyGC; /* Used for copying from pixmap onto screen. */ + #ifdef KANJI + XWSFontSet *fontPtr; + XFontStruct *asciiFontPtr; + XFontStruct *kanjiFontPtr; + #else XFontStruct *fontPtr; /* Information about text font, or NULL. */ + #endif /* KANJI */ XColor *textColorPtr; /* Color for drawing text. */ + #ifdef KANJI + XWSGC textGC; + #else GC textGC; /* GC for drawing text in normal mode. */ + #endif /* KANJI */ int relief; /* Indicates whether window as a whole is * raised, sunken, or flat. */ int highlightWidth; /* Width in pixels of highlight to draw *************** *** 240,248 **** --- 254,269 ---- DEF_SCALE_DIGITS, Tk_Offset(Scale, digits), 0}, {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL, (char *) NULL, 0, 0}, + #ifdef KANJI + {TK_CONFIG_FONT, "-font", "font", "Font", + DEF_SCALE_FONT, Tk_Offset(Scale, asciiFontPtr), 0}, + {TK_CONFIG_FONT, "-kanjifont", "kanjiFont", "KanjiFont", + DEF_SCALE_KANJIFONT, Tk_Offset(Scale, kanjiFontPtr), 0}, + #else {TK_CONFIG_FONT, "-font", "font", "Font", DEF_SCALE_FONT, Tk_Offset(Scale, fontPtr), 0}, + #endif /* KANJI */ {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground", DEF_SCALE_FG_COLOR, Tk_Offset(Scale, textColorPtr), TK_CONFIG_COLOR_ONLY}, *************** *** 259,266 **** --- 280,292 ---- {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness", "HighlightThickness", DEF_SCALE_HIGHLIGHT_WIDTH, Tk_Offset(Scale, highlightWidth), 0}, + #ifdef KANJI + {TK_CONFIG_WSTRING, "-label", "label", "Label", + DEF_SCALE_LABEL, Tk_Offset(Scale, label), TK_CONFIG_NULL_OK}, + #else {TK_CONFIG_STRING, "-label", "label", "Label", DEF_SCALE_LABEL, Tk_Offset(Scale, label), TK_CONFIG_NULL_OK}, + #endif /* KANJI */ {TK_CONFIG_PIXELS, "-length", "length", "Length", DEF_SCALE_LENGTH, Tk_Offset(Scale, length), 0}, {TK_CONFIG_UID, "-orient", "orient", "Orient", *************** *** 422,429 **** --- 448,463 ---- scalePtr->troughGC = None; scalePtr->copyGC = None; scalePtr->fontPtr = NULL; + #ifdef KANJI + scalePtr->asciiFontPtr = NULL; + scalePtr->kanjiFontPtr = NULL; + #endif /* KANJI */ scalePtr->textColorPtr = NULL; + #ifdef KANJI + scalePtr->textGC = NULL; + #else scalePtr->textGC = None; + #endif /* KANJI */ scalePtr->relief = TK_RELIEF_FLAT; scalePtr->highlightWidth = 0; scalePtr->highlightBgColorPtr = NULL; *************** *** 653,661 **** --- 687,706 ---- if (scalePtr->copyGC != None) { Tk_FreeGC(scalePtr->display, scalePtr->copyGC); } + #ifdef KANJI + if (scalePtr->fontPtr != NULL ) { + Tk_FreeFontSet(scalePtr->fontPtr); + } + #endif /* KANJI */ + #ifdef KANJI + if (scalePtr->textGC != NULL) { + Tk_FreeGCSet(scalePtr->display, scalePtr->textGC); + } + #else if (scalePtr->textGC != None) { Tk_FreeGC(scalePtr->display, scalePtr->textGC); } + #endif /* KANJI */ Tk_FreeOptions(configSpecs, (char *) scalePtr, scalePtr->display, 0); ckfree((char *) scalePtr); } *************** *** 691,696 **** --- 736,744 ---- int flags; /* Flags to pass to Tk_ConfigureWidget. */ { XGCValues gcValues; + #ifdef KANJI + XWSGC newGCSet; + #endif /* KANJI */ GC newGC; size_t length; *************** *** 709,714 **** --- 757,766 ---- return TCL_ERROR; } + #ifdef KANJI + scalePtr->fontPtr = Tk_GetFontSet(scalePtr->asciiFontPtr, scalePtr->kanjiFontPtr); + #endif /* KANJI */ + /* * If the scale is tied to the value of a variable, then set up * a trace on the variable's value and set the scale's value from *************** *** 773,779 **** --- 825,835 ---- SetScaleValue(scalePtr, scalePtr->value, 1, 1); if (scalePtr->label != NULL) { + #ifdef KANJI + scalePtr->labelLength = Tcl_WStrlen(scalePtr->label); + #else scalePtr->labelLength = strlen(scalePtr->label); + #endif /* KANJI */ } else { scalePtr->labelLength = 0; } *************** *** 803,815 **** --- 859,882 ---- if (scalePtr->highlightWidth < 0) { scalePtr->highlightWidth = 0; } + #ifndef KANJI gcValues.font = scalePtr->fontPtr->fid; + #endif /* !KANJI */ gcValues.foreground = scalePtr->textColorPtr->pixel; + #ifdef KANJI + newGCSet = Tk_GetGCSet(scalePtr->tkwin, GCForeground|GCFont, &gcValues, + scalePtr->fontPtr); + if (scalePtr->textGC != NULL) { + Tk_FreeGCSet(scalePtr->display, scalePtr->textGC); + } + scalePtr->textGC = newGCSet; + #else newGC = Tk_GetGC(scalePtr->tkwin, GCForeground|GCFont, &gcValues); if (scalePtr->textGC != None) { Tk_FreeGC(scalePtr->display, scalePtr->textGC); } scalePtr->textGC = newGC; + #endif /* KANJI */ scalePtr->inset = scalePtr->highlightWidth + scalePtr->borderWidth; *************** *** 1002,1013 **** --- 1069,1090 ---- */ sprintf(valueString, scalePtr->format, scalePtr->fromValue); + #ifdef KANJI + XTextExtents(scalePtr->asciiFontPtr, valueString, (int) strlen(valueString), + &dummy, &dummy, &dummy, &bbox); + #else XTextExtents(scalePtr->fontPtr, valueString, (int) strlen(valueString), &dummy, &dummy, &dummy, &bbox); + #endif /* KANJI */ valuePixels = bbox.rbearing - bbox.lbearing; sprintf(valueString, scalePtr->format, scalePtr->toValue); + #ifdef KANJI + XTextExtents(scalePtr->asciiFontPtr, valueString, (int) strlen(valueString), + &dummy, &dummy, &dummy, &bbox); + #else XTextExtents(scalePtr->fontPtr, valueString, (int) strlen(valueString), &dummy, &dummy, &dummy, &bbox); + #endif /* KANJI */ if (valuePixels < bbox.rbearing - bbox.lbearing) { valuePixels = bbox.rbearing - bbox.lbearing; } *************** *** 1040,1047 **** --- 1117,1129 ---- if (scalePtr->labelLength == 0) { scalePtr->vertLabelX = 0; } else { + #ifdef KANJI + TkWSTextExtents(scalePtr->textGC, scalePtr->label, + scalePtr->labelLength, &dummy, &dummy, &bbox); + #else XTextExtents(scalePtr->fontPtr, scalePtr->label, scalePtr->labelLength, &dummy, &dummy, &dummy, &bbox); + #endif /* KANJI */ scalePtr->vertLabelX = x + scalePtr->fontPtr->ascent/2 - bbox.lbearing; x = scalePtr->vertLabelX + bbox.rbearing + scalePtr->fontPtr->ascent/2; *************** *** 1183,1192 **** --- 1265,1281 ---- */ if ((scalePtr->flags & REDRAW_OTHER) && (scalePtr->labelLength != 0)) { + #ifdef KANJI + TkWSDrawString(scalePtr->display, drawable, + scalePtr->textGC, scalePtr->vertLabelX, + scalePtr->inset + (3*scalePtr->fontPtr->ascent)/2, + scalePtr->label, scalePtr->labelLength); + #else XDrawString(scalePtr->display, drawable, scalePtr->textGC, scalePtr->vertLabelX, scalePtr->inset + (3*scalePtr->fontPtr->ascent)/2, scalePtr->label, scalePtr->labelLength); + #endif /* KANJI */ } } *************** *** 1226,1236 **** --- 1315,1334 ---- char valueString[PRINT_CHARS]; XCharStruct bbox; + #ifdef KANJI + y = ValueToPixel(scalePtr, value) + scalePtr->asciiFontPtr->ascent/2; + #else y = ValueToPixel(scalePtr, value) + scalePtr->fontPtr->ascent/2; + #endif /* KANJI */ sprintf(valueString, scalePtr->format, value); length = strlen(valueString); + #ifdef KANJI + XTextExtents(scalePtr->asciiFontPtr, valueString, length, + &dummy, &dummy, &dummy, &bbox); + #else XTextExtents(scalePtr->fontPtr, valueString, length, &dummy, &dummy, &dummy, &bbox); + #endif /* KANJI */ /* * Adjust the y-coordinate if necessary to keep the text entirely *************** *** 1243,1250 **** --- 1341,1353 ---- if ((y + bbox.descent) > (Tk_Height(tkwin) - scalePtr->inset - SPACING)) { y = Tk_Height(tkwin) - scalePtr->inset - SPACING - bbox.descent; } + #ifdef KANJI + XDrawString(scalePtr->display, drawable, scalePtr->textGC->fe[0].gc, + rightEdge - bbox.rbearing, y, valueString, length); + #else XDrawString(scalePtr->display, drawable, scalePtr->textGC, rightEdge - bbox.rbearing, y, valueString, length); + #endif /* KANJI */ } /* *************** *** 1380,1389 **** --- 1483,1499 ---- */ if ((scalePtr->flags & REDRAW_OTHER) && (scalePtr->labelLength != 0)) { + #ifdef KANJI + TkWSDrawString(scalePtr->display, drawable, + scalePtr->textGC, scalePtr->inset + scalePtr->fontPtr->ascent/2, + scalePtr->horizLabelY + scalePtr->fontPtr->ascent, + scalePtr->label, scalePtr->labelLength); + #else XDrawString(scalePtr->display, drawable, scalePtr->textGC, scalePtr->inset + scalePtr->fontPtr->ascent/2, scalePtr->horizLabelY + scalePtr->fontPtr->ascent, scalePtr->label, scalePtr->labelLength); + #endif /* KANJI */ } } *************** *** 1427,1434 **** --- 1537,1549 ---- y = top + scalePtr->fontPtr->ascent; sprintf(valueString, scalePtr->format, value); length = strlen(valueString); + #ifdef KANJI + XTextExtents(scalePtr->asciiFontPtr, valueString, length, + &dummy, &dummy, &dummy, &bbox); + #else XTextExtents(scalePtr->fontPtr, valueString, length, &dummy, &dummy, &dummy, &bbox); + #endif /* KANJI */ /* * Adjust the x-coordinate if necessary to keep the text entirely *************** *** 1442,1449 **** --- 1557,1569 ---- if ((x + bbox.rbearing) > (Tk_Width(tkwin) - scalePtr->inset)) { x = Tk_Width(tkwin) - scalePtr->inset - SPACING - bbox.rbearing; } + #ifdef KANJI + XDrawString(scalePtr->display, drawable, scalePtr->textGC->fe[0].gc, x, y, + valueString, length); + #else XDrawString(scalePtr->display, drawable, scalePtr->textGC, x, y, valueString, length); + #endif /* KANJI */ } /* diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/generic/tkSelect.c ./generic/tkSelect.c *** ../tk4.2/generic/tkSelect.c Sun Oct 13 09:14:34 1996 --- ./generic/tkSelect.c Fri Oct 18 13:14:53 1996 *************** *** 58,63 **** --- 58,67 ---- static int HandleTclCommand _ANSI_ARGS_((ClientData clientData, int offset, char *buffer, int maxBytes)); + #ifdef KANJI + static int HandleTclCommandCtext _ANSI_ARGS_((ClientData clientData, + int offset, char *buffer, int maxBytes)); + #endif /* KANJI */ static void LostSelection _ANSI_ARGS_((ClientData clientData)); static int SelGetProc _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, char *portion)); *************** *** 152,158 **** --- 156,167 ---- * callback to allow other clients to do this too? */ + #ifdef KANJI + if (selPtr->proc == HandleTclCommand || + selPtr->proc == HandleTclCommandCtext) { + #else if (selPtr->proc == HandleTclCommand) { + #endif /* KANJI */ ckfree((char *) selPtr->clientData); } break; *************** *** 163,169 **** --- 172,182 ---- selPtr->format = format; selPtr->proc = proc; selPtr->clientData = clientData; + #ifdef KANJI + if (format == XA_STRING || format == winPtr->dispPtr->compoundTextAtom) { + #else if (format == XA_STRING) { + #endif /* KANJI */ selPtr->size = 8; } else { selPtr->size = 32; *************** *** 235,241 **** --- 248,259 ---- } else { prevPtr->nextPtr = selPtr->nextPtr; } + #ifdef KANJI + if (selPtr->proc == HandleTclCommand || + selPtr->proc == HandleTclCommandCtext) { + #else if (selPtr->proc == HandleTclCommand) { + #endif /* KANJI */ ckfree((char *) selPtr->clientData); } ckfree((char *) selPtr); *************** *** 658,663 **** --- 676,684 ---- char *targetName = NULL; Tcl_DString selBytes; int result; + #ifdef KANJI + Atom ctextatom = Tk_InternAtom(tkwin, "COMPOUND_TEXT"); + #endif /* KANJI */ for (count = argc-2, args = argv+2; count > 0; count -= 2, args += 2) { if (args[0][0] != '-') { *************** *** 704,717 **** --- 725,762 ---- } else if (targetName != NULL) { target = Tk_InternAtom(tkwin, targetName); } else { + #ifdef KANJI + target = ctextatom; + #else target = XA_STRING; + #endif /* KANJI */ } Tcl_DStringInit(&selBytes); result = Tk_GetSelection(interp, tkwin, selection, target, SelGetProc, (ClientData) &selBytes); if (result == TCL_OK) { + #ifdef KANJI + if (target == ctextatom || target == Tk_InternAtom(tkwin, "TEXT")) { + int kanjiCode = Tcl_KanjiCode(interp); + wchar *ws = Tk_CtextToWStr(Tcl_DStringValue(&selBytes), + Tcl_DStringLength(&selBytes)); + + Tcl_DStringFree(&selBytes); + if (ws != NULL) { + int count = Tcl_KanjiDecode(kanjiCode, ws, NULL); + char *str = ckalloc((unsigned int)(count + 1)); + + (void) Tcl_KanjiDecode(kanjiCode, ws, str); + ckfree((char *)ws); + Tcl_SetResult(interp, str, TCL_DYNAMIC); + } + } else { + Tcl_DStringResult(interp, &selBytes); + } + #else /* KANJI */ Tcl_DStringResult(interp, &selBytes); + #endif /* KANJI */ } else { Tcl_DStringFree(&selBytes); } *************** *** 722,727 **** --- 767,775 ---- char *formatName = NULL; register CommandInfo *cmdInfoPtr; int cmdLength; + #ifdef KANJI + Atom ctextatom = Tk_InternAtom(tkwin, "COMPOUND_TEXT"); + #endif /* KANJI */ for (count = argc-2, args = argv+2; count > 0; count -= 2, args += 2) { if (args[0][0] != '-') { *************** *** 769,782 **** --- 817,838 ---- } else if (targetName != NULL) { target = Tk_InternAtom(tkwin, targetName); } else { + #ifdef KANJI + target = ctextatom; + #else target = XA_STRING; + #endif /* KANJI */ } if (count > 3) { format = Tk_InternAtom(tkwin, args[3]); } else if (formatName != NULL) { format = Tk_InternAtom(tkwin, formatName); } else { + #ifdef KANJI + format = ctextatom; + #else format = XA_STRING; + #endif /* KANJI */ } cmdLength = strlen(args[1]); if (cmdLength == 0) { *************** *** 787,792 **** --- 843,855 ---- cmdInfoPtr->interp = interp; cmdInfoPtr->cmdLength = cmdLength; strcpy(cmdInfoPtr->command, args[1]); + #ifdef KANJI + if (format == ctextatom || + format == Tk_InternAtom(tkwin, "TEXT")) { + Tk_CreateSelHandler(tkwin, selection, target, HandleTclCommandCtext, + (ClientData) cmdInfoPtr, format); + } else + #endif /* KANJI */ Tk_CreateSelHandler(tkwin, selection, target, HandleTclCommand, (ClientData) cmdInfoPtr, format); } *************** *** 924,930 **** --- 987,998 ---- ipPtr->selPtr = NULL; } } + #ifdef KANJI + if (selPtr->proc == HandleTclCommand || + selPtr->proc == HandleTclCommandCtext) { + #else /* KANJI */ if (selPtr->proc == HandleTclCommand) { + #endif /* KANJI */ ckfree((char *) selPtr->clientData); } ckfree((char *) selPtr); *************** *** 1173,1178 **** --- 1241,1339 ---- Tcl_Release((ClientData) interp); return length; } + + #ifdef KANJI + /* + *---------------------------------------------------------------------- + * + * HandleTclCommandCtext -- + * + * This procedure is same as HandleTclCommand except it + * converts the result string to COMPOUND_TEXT before passing + * to the selection requestor. + * + * Results: + * See HandleTclCommand. + * + * Side effects: + * None except for things done by the Tcl command. + * + *---------------------------------------------------------------------- + */ + + static int + HandleTclCommandCtext(clientData, offset, buffer, maxBytes) + ClientData clientData; /* Information about command to execute. */ + int offset; /* Return selection bytes starting at this + * offset. */ + char *buffer; /* Place to store converted selection. */ + int maxBytes; /* Maximum # of bytes to store at buffer. */ + { + CommandInfo *cmdInfoPtr = (CommandInfo *) clientData; + int spaceNeeded, length; + #define MAX_STATIC_SIZE 100 + char staticSpace[MAX_STATIC_SIZE]; + char *command; + Tcl_Interp *interp; + Tcl_DString oldResult; + int kanjiCode = Tcl_KanjiCode(cmdInfoPtr->interp); + + /* + * We must copy the interpreter pointer from CommandInfo because the + * command could delete the handler, freeing the CommandInfo data before we + * are done using it. + */ + + interp = cmdInfoPtr->interp; + + /* + * First, generate a command by taking the command string + * and appending the offset and maximum # of bytes. + */ + + spaceNeeded = cmdInfoPtr->cmdLength + 30; + if (spaceNeeded < MAX_STATIC_SIZE) { + command = staticSpace; + } else { + command = (char *) ckalloc((unsigned) spaceNeeded); + } + sprintf(command, "%s %d %d", cmdInfoPtr->command, offset, maxBytes); + + /* + * Execute the command. Be sure to restore the state of the + * interpreter after executing the command. + */ + + Tcl_DStringInit(&oldResult); + Tcl_DStringGetResult(interp, &oldResult); + if (Tcl_GlobalEval(interp, command) == TCL_OK) { + char *result = interp->result; + int count = Tcl_KanjiEncode(kanjiCode, result, NULL); + wchar *wstr = (wchar *)ckalloc(sizeof(wchar) * (unsigned)(count + 1)); + + (void) Tcl_KanjiEncode(kanjiCode, result, wstr); + result = Tk_WStrToCtext(wstr, -1); + ckfree((char *)wstr); + + length = (result == NULL) ? 0 : strlen(result); + if (length > maxBytes) { + length = maxBytes; + } + memcpy((VOID *) buffer, (VOID *) result, length); + buffer[length] = '\0'; + if (result != NULL) ckfree(result); + } else { + length = -1; + } + Tcl_DStringResult(interp, &oldResult); + + if (command != staticSpace) { + ckfree(command); + } + + return length; + } + #endif /* KANJI */ /* *---------------------------------------------------------------------- diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/generic/tkText.c ./generic/tkText.c *** ../tk4.2/generic/tkText.c Tue Aug 27 02:09:25 1996 --- ./generic/tkText.c Fri Oct 18 13:14:54 1996 *************** *** 49,56 **** --- 49,63 ---- Tk_Offset(TkText, exportSelection), 0}, {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL, (char *) NULL, 0, 0}, + #ifdef KANJI + {TK_CONFIG_FONT, "-font", "font", "Font", + DEF_TEXT_FONT, Tk_Offset(TkText, asciiFontPtr), 0}, + {TK_CONFIG_FONT, "-kanjifont", "kanjiFont", "KanjiFont", + DEF_TEXT_KANJIFONT, Tk_Offset(TkText, kanjiFontPtr), 0}, + #else {TK_CONFIG_FONT, "-font", "font", "Font", DEF_TEXT_FONT, Tk_Offset(TkText, fontPtr), 0}, + #endif /* KANJI */ {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground", DEF_TEXT_FG, Tk_Offset(TkText, fgColor), 0}, {TK_CONFIG_PIXELS, "-height", "height", "Height", *************** *** 168,175 **** --- 175,191 ---- XEvent *eventPtr)); static int TextFetchSelection _ANSI_ARGS_((ClientData clientData, int offset, char *buffer, int maxBytes)); + #ifdef KANJI + static int TextFetchSelectionCtext _ANSI_ARGS_(( + ClientData clientData, + int offset, char *buffer, int maxBytes)); + #endif /* KANJI */ static int TextSearchCmd _ANSI_ARGS_((TkText *textPtr, Tcl_Interp *interp, int argc, char **argv)); + #ifdef KANJI + static int KanjiTextSearchCmd _ANSI_ARGS_((TkText *textPtr, + Tcl_Interp *interp, int argc, char **argv)); + #endif /* KANJI */ static int TextWidgetCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int argc, char **argv)); static int TextDumpCmd _ANSI_ARGS_((TkText *textPtr, *************** *** 263,268 **** --- 279,288 ---- textPtr->cursor = None; textPtr->fgColor = NULL; textPtr->fontPtr = NULL; + #ifdef KANJI + textPtr->asciiFontPtr = NULL; + textPtr->kanjiFontPtr = NULL; + #endif /* KANJI */ textPtr->charWidth = 1; textPtr->spacing1 = 0; textPtr->spacing2 = 0; *************** *** 311,316 **** --- 331,349 ---- textPtr->selTagPtr->reliefString = (char *) ckalloc(7); strcpy(textPtr->selTagPtr->reliefString, "raised"); textPtr->selTagPtr->relief = TK_RELIEF_RAISED; + #ifdef KANJI + { + Atom textatom = Tk_InternAtom(textPtr->tkwin, "TEXT"); + Atom ctextatom = Tk_InternAtom(textPtr->tkwin, "COMPOUND_TEXT"); + + Tk_CreateSelHandler(textPtr->tkwin, XA_PRIMARY, textatom, + TextFetchSelectionCtext, + (ClientData) textPtr, ctextatom); + Tk_CreateSelHandler(textPtr->tkwin, XA_PRIMARY, ctextatom, + TextFetchSelectionCtext, + (ClientData) textPtr, ctextatom); + } + #endif /* KANJI */ textPtr->currentMarkPtr = TkTextSetMark(textPtr, "current", &startIndex); textPtr->insertMarkPtr = TkTextSetMark(textPtr, "insert", &startIndex); *************** *** 528,534 **** --- 561,574 ---- goto done; } while (1) { + #ifdef KANJI + int offset, last; + wchar savedChar; + int length, kanjiCode = Tcl_KanjiCode(interp); + char *str; + #else int offset, last, savedChar; + #endif /* KANJI */ TkTextSegment *segPtr; segPtr = TkTextIndexToSeg(&index1, &offset); *************** *** 547,554 **** --- 587,602 ---- if (segPtr->typePtr == &tkTextCharType) { savedChar = segPtr->body.chars[last]; segPtr->body.chars[last] = 0; + #ifdef KANJI + length = Tcl_KanjiDecode(kanjiCode, segPtr->body.chars+offset, NULL); + str = (char *) ckalloc((unsigned)(length + 1)); + (void) Tcl_KanjiDecode(kanjiCode, segPtr->body.chars+offset, str); + Tcl_AppendResult(interp, str, (char *) NULL); + ckfree(str); + #else Tcl_AppendResult(interp, segPtr->body.chars + offset, (char *) NULL); + #endif /* KANJI */ segPtr->body.chars[last] = savedChar; } TkTextIndexForwChars(&index1, last-offset, &index1); *************** *** 572,577 **** --- 620,628 ---- int i, j, numTags; char **tagNames; TkTextTag **oldTagArrayPtr; + #ifdef KANJI + wchar *wstr; + #endif /* KANJI */ if (argc < 4) { Tcl_AppendResult(interp, "wrong # args: should be \"", *************** *** 589,596 **** --- 640,654 ---- for (j = 3; j < argc; j += 2) { InsertChars(textPtr, &index1, argv[j]); if (argc > (j+1)) { + #ifdef KANJI + wstr = Tk_GetWStr(interp, argv[j]); + TkTextIndexForwChars(&index1, (int) Tcl_WStrlen(wstr), + &index2); + Tk_FreeWStr(wstr); + #else TkTextIndexForwChars(&index1, (int) strlen(argv[j]), &index2); + #endif /* KANJI */ oldTagArrayPtr = TkBTreeGetTags(&index1, &numTags); if (oldTagArrayPtr != NULL) { for (i = 0; i < numTags; i++) { *************** *** 620,626 **** --- 678,697 ---- result = TkTextScanCmd(textPtr, interp, argc, argv); } else if ((c == 's') && (strcmp(argv[1], "search") == 0) && (length >= 3)) { + #ifdef KANJI + int i, kanjiCode = TCL_ANY; + for (i = 2; i < argc; i++) { + if (argv[i][0] == '-') continue; + if (Tcl_KanjiString(interp, argv[i], &kanjiCode) != TCL_NOT_KANJI) break; + } + if (kanjiCode == TCL_ANY) { + result = TextSearchCmd(textPtr, interp, argc, argv); + } else { + result = KanjiTextSearchCmd(textPtr, interp, argc, argv); + } + #else result = TextSearchCmd(textPtr, interp, argc, argv); + #endif /* KANJI */ } else if ((c == 's') && (strcmp(argv[1], "see") == 0) && (length >= 3)) { result = TkTextSeeCmd(textPtr, interp, argc, argv); } else if ((c == 't') && (strcmp(argv[1], "tag") == 0)) { *************** *** 629,634 **** --- 700,719 ---- result = TkTextWindowCmd(textPtr, interp, argc, argv); } else if ((c == 'x') && (strncmp(argv[1], "xview", length) == 0)) { result = TkTextXviewCmd(textPtr, interp, argc, argv); + #ifdef KINPUT2 + } else if ((c == 'x') && (strncmp(argv[1], "xypos", length) == 0)) { + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " xypos index\"", (char *) NULL); + result = TCL_ERROR; + goto done; + } + if (TkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK || + TkTextXYPos(interp, textPtr, &index1) != TCL_OK) { + result = TCL_ERROR; + goto done; + } + #endif /* KINPUT2 */ } else if ((c == 'y') && (strncmp(argv[1], "yview", length) == 0) && (length >= 2)) { result = TkTextYviewCmd(textPtr, interp, argc, argv); *************** *** 636,642 **** --- 721,731 ---- Tcl_AppendResult(interp, "bad option \"", argv[1], "\": must be bbox, cget, compare, configure, debug, delete, ", "dlineinfo, get, index, insert, mark, scan, search, see, ", + #ifdef KINPUT2 + "tag, window, xview, xypos, or yview", + #else "tag, window, xview, or yview", + #endif /* KINPUT2 */ (char *) NULL); result = TCL_ERROR; } *************** *** 710,715 **** --- 799,809 ---- * freed up as part of deleting the tags above. */ + #ifdef KANJI + if (textPtr->fontPtr != NULL ) { + Tk_FreeFontSet(textPtr->fontPtr); + } + #endif /* KANJI */ textPtr->selBorder = NULL; textPtr->selBdString = NULL; textPtr->selFgColorPtr = NULL; *************** *** 755,760 **** --- 849,858 ---- return TCL_ERROR; } + #ifdef KANJI + textPtr->fontPtr = Tk_GetFontSet(textPtr->asciiFontPtr, textPtr->kanjiFontPtr); + #endif /* KANJI */ + /* * A few other options also need special processing, such as parsing * the geometry and setting the background from a 3-D border. *************** *** 838,844 **** --- 936,947 ---- || (textPtr->selTagPtr->reliefString != NULL) || (textPtr->selTagPtr->bgStipple != None) || (textPtr->selTagPtr->fgColor != NULL) + #ifdef KANJI + || (textPtr->selTagPtr->asciiFontPtr != NULL) + || (textPtr->selTagPtr->kanjiFontPtr != NULL) + #else || (textPtr->selTagPtr->fontPtr != None) + #endif /* KANJI */ || (textPtr->selTagPtr->fgStipple != None) || (textPtr->selTagPtr->justifyString != NULL) || (textPtr->selTagPtr->lMargin1String != NULL) *************** *** 889,895 **** --- 992,1002 ---- if (textPtr->height <= 0) { textPtr->height = 1; } + #ifdef KANJI + textPtr->charWidth = XTextWidth(textPtr->asciiFontPtr, "0", 1); + #else textPtr->charWidth = XTextWidth(textPtr->fontPtr, "0", 1); + #endif /* KANJI */ if (textPtr->charWidth <= 0) { textPtr->charWidth = 1; } *************** *** 1287,1292 **** --- 1394,1403 ---- int count, chunkSize, offsetInSeg; TkTextSearch search; TkTextSegment *segPtr; + #ifdef KANJI + char *str; + int numBytes; + #endif /* KANJI */ if (!textPtr->exportSelection) { return -1; *************** *** 1347,1355 **** --- 1458,1479 ---- } segPtr = TkTextIndexToSeg(&textPtr->selIndex, &offsetInSeg); chunkSize = segPtr->size - offsetInSeg; + #ifdef KANJI + str = Tk_WStrToCtext(segPtr->body.chars+offsetInSeg, chunkSize); + numBytes = ((str == NULL) ? 0 : strlen(str)); + if (offset > numBytes) { + offset -= numBytes; + goto next; + } + numBytes -= offset; + if (numBytes > maxBytes) { + numBytes = maxBytes; + } + #else if (chunkSize > maxBytes) { chunkSize = maxBytes; } + #endif /* KANJI */ if (textPtr->selIndex.linePtr == search.curIndex.linePtr) { int leftInRange; *************** *** 1358,1376 **** --- 1482,1669 ---- if (leftInRange < chunkSize) { chunkSize = leftInRange; if (chunkSize <= 0) { + #ifdef KANJI + if (str != NULL) ckfree(str); + #endif /* KANJI */ break; } } } if (segPtr->typePtr == &tkTextCharType) { + #ifdef KANJI + memcpy((VOID *) buffer, (VOID *) (str + offset), (size_t) numBytes); + offset = 0; + + buffer += numBytes; + maxBytes -= numBytes; + count += numBytes; + #else memcpy((VOID *) buffer, (VOID *) (segPtr->body.chars + offsetInSeg), (size_t) chunkSize); buffer += chunkSize; maxBytes -= chunkSize; count += chunkSize; + #endif /* KANJI */ } + #ifdef KANJI + next: + if (str != NULL) ckfree(str); + if (maxBytes > 0) { + TkTextIndexForwChars(&textPtr->selIndex, chunkSize, + &textPtr->selIndex); + } + #else TkTextIndexForwChars(&textPtr->selIndex, chunkSize, &textPtr->selIndex); + #endif /* KANJI */ + } + + /* + * Find the beginning of the next range of selected text. + */ + + if (!TkBTreeNextTag(&search)) { + break; + } + textPtr->selIndex = search.curIndex; + } + + done: + *buffer = 0; + return count; + } + + #ifdef KANJI + /* + *---------------------------------------------------------------------- + * + * TextFetchSelectionCtext -- + * + * This procedure is similar to TextFetchSelection except + * it converts the selection to COMPOUND_TEXT before + * passing it to the requester. + * + * Results: + * See TextFetchSelection. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + static int + TextFetchSelectionCtext(clientData, offset, buffer, maxBytes) + ClientData clientData; /* Information about text widget. */ + int offset; /* Offset within selection of first + * character to be returned. */ + char *buffer; /* Location in which to place + * selection. */ + int maxBytes; /* Maximum number of bytes to place + * at buffer, not including terminating + * NULL character. */ + { + register TkText *textPtr = (TkText *) clientData; + TkTextIndex eof; + int count, chunkSize, offsetInSeg; + TkTextSearch search; + TkTextSegment *segPtr; + char *str; + int numBytes; + + if (!textPtr->exportSelection) { + return -1; + } + + /* + * Find the beginning of the next range of selected text. Note: if + * the selection is being retrieved in multiple pieces (offset != 0) + * and some modification has been made to the text that affects the + * selection then reject the selection request (make 'em start over + * again). + */ + + if (offset != 0 && textPtr->abortSelections) return 0; + TkTextMakeIndex(textPtr->tree, 0, 0, &textPtr->selIndex); + textPtr->abortSelections = 0; + TkTextMakeIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), 0, &eof); + TkBTreeStartSearch(&textPtr->selIndex, &eof, textPtr->selTagPtr, &search); + if (!TkBTreeCharTagged(&textPtr->selIndex, textPtr->selTagPtr)) { + if (!TkBTreeNextTag(&search)) { + if (offset == 0) { + return -1; + } else { + return 0; + } + } + textPtr->selIndex = search.curIndex; + } + + /* + * Each iteration through the outer loop below scans one selected range. + * Each iteration through the inner loop scans one segment in the + * selected range. + */ + + count = 0; + while (1) { + /* + * Find the end of the current range of selected text. + */ + + if (!TkBTreeNextTag(&search)) { + panic("TextFetchSelection couldn't find end of range"); + } + + /* + * Copy information from character segments into the buffer + * until either we run out of space in the buffer or we get + * to the end of this range of text. + */ + + while (1) { + if (maxBytes == 0) { + goto done; + } + segPtr = TkTextIndexToSeg(&textPtr->selIndex, &offsetInSeg); + chunkSize = segPtr->size - offsetInSeg; + str = Tk_WStrToCtext(segPtr->body.chars+offsetInSeg, chunkSize); + numBytes = ((str == NULL) ? 0 : strlen(str)); + if (offset > numBytes) { + offset -= numBytes; + goto next; + } + numBytes -= offset; + if (numBytes > maxBytes) { + numBytes = maxBytes; + } + if (textPtr->selIndex.linePtr == search.curIndex.linePtr) { + int leftInRange; + + leftInRange = search.curIndex.charIndex + - textPtr->selIndex.charIndex; + if (leftInRange < chunkSize) { + chunkSize = leftInRange; + if (chunkSize <= 0) { + if (str != NULL) ckfree(str); + break; + } + } + } + if (segPtr->typePtr == &tkTextCharType) { + memcpy((VOID *) buffer, (VOID *) (str + offset), (size_t) numBytes); + offset = 0; + + buffer += numBytes; + maxBytes -= numBytes; + count += numBytes; + } + next: + if (str != NULL) ckfree(str); + if (maxBytes > 0) { + TkTextIndexForwChars(&textPtr->selIndex, chunkSize, + &textPtr->selIndex); + } } /* *************** *** 1387,1392 **** --- 1680,1686 ---- *buffer = 0; return count; } + #endif /* KANJI */ /* *---------------------------------------------------------------------- *************** *** 1644,1653 **** --- 1938,1961 ---- linePtr = TkBTreeFindLine(textPtr->tree, lineNum); for (segPtr = linePtr->segPtr; segPtr != NULL; segPtr = segPtr->nextPtr) { + #ifdef KANJI + int i; + char *str; + #endif /* KANJI */ if (segPtr->typePtr != &tkTextCharType) { continue; } + #ifdef KANJI + str = ckalloc((unsigned) (segPtr->size + 1)); + for (i = 0; i < segPtr->size; i++) { + str[i] = (char) segPtr->body.chars[i]; + } + str[segPtr->size] = 0; + Tcl_DStringAppend(&line, str, strlen(str)); + ckfree(str); + #else Tcl_DStringAppend(&line, segPtr->body.chars, segPtr->size); + #endif /* KANJI */ } if (!exact) { Tcl_DStringSetLength(&line, Tcl_DStringLength(&line)-1); *************** *** 1835,1840 **** --- 2143,2586 ---- return code; } + #ifdef KANJI + /* + *---------------------------------------------------------------------- + * + * KanjiTextSearchCmd -- + * + * This procedure is invoked to process the "search" widget command + * for text widgets. See the user documentation for details on what + * it does. This procedure is copied from "TextSearchCmd" and + * modified for the kanji characters. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + + static int + KanjiTextSearchCmd(textPtr, interp, argc, argv) + TkText *textPtr; /* Information about text widget. */ + Tcl_Interp *interp; /* Current interpreter. */ + int argc; /* Number of arguments. */ + char **argv; /* Argument strings. */ + { + int backwards, exact, c, i, argsLeft, noCase, leftToScan; + size_t length; + int numLines, startingLine, startingChar, lineNum, firstChar, lastChar; + int code, matchLength, matchChar, passes, stopLine, searchWholeText; + int patLength; + #ifdef KANJI + char *arg, *varName; + wchar *pattern, *pPattern, *p, *startOfLine; + #else + char *arg, *pattern, *varName, *p, *startOfLine; + #endif /* KANJI */ + char buffer[20]; + TkTextIndex index, stopIndex; + #ifdef KANJI + Tcl_DWString line, patDString; + #else + Tcl_DString line, patDString; + #endif /* KANJI */ + TkTextSegment *segPtr; + TkTextLine *linePtr; + Tcl_RegExp regexp = NULL; /* Initialization needed only to + * prevent compiler warning. */ + + /* + * Parse switches and other arguments. + */ + + exact = 1; + backwards = 0; + noCase = 0; + varName = NULL; + for (i = 2; i < argc; i++) { + arg = argv[i]; + if (arg[0] != '-') { + break; + } + length = strlen(arg); + if (length < 2) { + badSwitch: + Tcl_AppendResult(interp, "bad switch \"", arg, + "\": must be -forward, -backward, -exact, -regexp, ", + "-nocase, -count, or --", (char *) NULL); + return TCL_ERROR; + } + c = arg[1]; + if ((c == 'b') && (strncmp(argv[i], "-backwards", length) == 0)) { + backwards = 1; + } else if ((c == 'c') && (strncmp(argv[i], "-count", length) == 0)) { + if (i >= (argc-1)) { + interp->result = "no value given for \"-count\" option"; + return TCL_ERROR; + } + i++; + varName = argv[i]; + } else if ((c == 'e') && (strncmp(argv[i], "-exact", length) == 0)) { + exact = 1; + #ifdef KANJI + interp->result = "-regexp is not available for kanji characters"; + return TCL_ERROR; + #endif /* KANJI */ + } else if ((c == 'f') && (strncmp(argv[i], "-forwards", length) == 0)) { + backwards = 0; + } else if ((c == 'n') && (strncmp(argv[i], "-nocase", length) == 0)) { + noCase = 1; + } else if ((c == 'r') && (strncmp(argv[i], "-regexp", length) == 0)) { + exact = 0; + } else if ((c == '-') && (strncmp(argv[i], "--", length) == 0)) { + i++; + break; + } else { + goto badSwitch; + } + } + argsLeft = argc - (i+2); + if ((argsLeft != 0) && (argsLeft != 1)) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " search ?switches? pattern index ?stopIndex?", + (char *) NULL); + return TCL_ERROR; + } + #ifdef KANJI + pattern = pPattern = Tk_GetWStr(interp, argv[i]); + #else + pattern = argv[i]; + #endif /* KANJI */ + + /* + * Convert the pattern to lower-case if we're supposed to ignore case. + */ + + if (noCase) { + #ifdef KANJI + Tcl_DWStringInit(&patDString); + Tcl_DWStringAppend(&patDString, pattern, -1); + pattern = Tcl_DWStringValue(&patDString); + for (p = pattern; *p != 0; p++) { + if (ISWUPPER(*p)) { + *p = (wchar) tolower(UCHAR(*p)); + } + } + #else + Tcl_DStringInit(&patDString); + Tcl_DStringAppend(&patDString, pattern, -1); + pattern = Tcl_DStringValue(&patDString); + for (p = pattern; *p != 0; p++) { + if (isupper(UCHAR(*p))) { + *p = tolower(UCHAR(*p)); + } + } + #endif /* KANJI */ + } + + if (TkTextGetIndex(interp, textPtr, argv[i+1], &index) != TCL_OK) { + #ifdef KANJI + Tk_FreeWStr(pPattern); + if (noCase) { + Tcl_DWStringFree(&patDString); + } + #endif /* KANJI */ + return TCL_ERROR; + } + numLines = TkBTreeNumLines(textPtr->tree); + startingLine = TkBTreeLineIndex(index.linePtr); + startingChar = index.charIndex; + if (startingLine >= numLines) { + startingLine = 0; + startingChar = 0; + } + if (argsLeft == 1) { + if (TkTextGetIndex(interp, textPtr, argv[i+2], &stopIndex) != TCL_OK) { + #ifdef KANJI + Tk_FreeWStr(pPattern); + if (noCase) { + Tcl_DWStringFree(&patDString); + } + #endif /* KANJI */ + return TCL_ERROR; + } + stopLine = TkBTreeLineIndex(stopIndex.linePtr); + if (!backwards && (stopLine == numLines)) { + stopLine = numLines-1; + } + searchWholeText = 0; + } else { + stopLine = 0; + searchWholeText = 1; + } + + /* + * Scan through all of the lines of the text circularly, starting + * at the given index. + */ + + matchLength = patLength = 0; /* Only needed to prevent compiler + * warnings. */ + if (exact) { + #ifdef KANJI + patLength = Tcl_WStrlen(pattern); + #else + patLength = strlen(pattern); + #endif /* KANJI */ + } else { + #ifdef KANJI + #else + regexp = Tcl_RegExpCompile(interp, pattern); + if (regexp == NULL) { + return TCL_ERROR; + } + #endif /* KANJI */ + } + lineNum = startingLine; + code = TCL_OK; + #ifdef KANJI + Tcl_DWStringInit(&line); + #else + Tcl_DStringInit(&line); + #endif /* KANJI */ + for (passes = 0; passes < 2; ) { + if (lineNum >= numLines) { + /* + * Don't search the dummy last line of the text. + */ + + goto nextLine; + } + + /* + * Extract the text from the line. If we're doing regular + * expression matching, drop the newline from the line, so + * that "$" can be used to match the end of the line. + */ + + linePtr = TkBTreeFindLine(textPtr->tree, lineNum); + for (segPtr = linePtr->segPtr; segPtr != NULL; + segPtr = segPtr->nextPtr) { + if (segPtr->typePtr != &tkTextCharType) { + continue; + } + #ifdef KANJI + Tcl_DWStringAppend(&line, segPtr->body.chars, segPtr->size); + #else + Tcl_DStringAppend(&line, segPtr->body.chars, segPtr->size); + #endif /* KANJI */ + } + if (!exact) { + #ifdef KANJI + Tcl_DWStringSetLength(&line, Tcl_DWStringLength(&line)-1); + #else + Tcl_DStringSetLength(&line, Tcl_DStringLength(&line)-1); + #endif /* KANJI */ + } + #ifdef KANJI + startOfLine = Tcl_DWStringValue(&line); + #else + startOfLine = Tcl_DStringValue(&line); + #endif /* KANJI */ + + /* + * If we're ignoring case, convert the line to lower case. + */ + + if (noCase) { + #ifdef KANJI + for (p = Tcl_DWStringValue(&line); *p != 0; p++) { + if (ISWUPPER(*p)) { + *p = (wchar) tolower(UCHAR(*p)); + } + } + #else + for (p = Tcl_DStringValue(&line); *p != 0; p++) { + if (isupper(UCHAR(*p))) { + *p = tolower(UCHAR(*p)); + } + } + #endif /* KANJI */ + } + + /* + * Check for matches within the current line. If so, and if we're + * searching backwards, repeat the search to find the last match + * in the line. + */ + + matchChar = -1; + firstChar = 0; + lastChar = INT_MAX; + if (lineNum == startingLine) { + /* + * The starting line is tricky: the first time we see it + * we check one part of the line, and the second pass through + * we check the other part of the line. + */ + + passes++; + if (passes == 1) { + if (backwards) { + lastChar = startingChar; + } else { + firstChar = startingChar; + if (firstChar >= Tcl_DStringLength(&line)) { + goto nextLine; + } + } + } else { + if (backwards) { + firstChar = startingChar; + } else { + lastChar = startingChar; + } + } + } + do { + int thisLength; + if (exact) { + #ifdef KANJI + p = Tcl_WStrstr(startOfLine + firstChar, pattern); + #else + p = strstr(startOfLine + firstChar, pattern); + #endif /* KANJI */ + if (p == NULL) { + break; + } + i = p - startOfLine; + thisLength = patLength; + } else { + #ifdef KANJI + #else + char *start, *end; + int match; + + match = Tcl_RegExpExec(interp, regexp, + startOfLine + firstChar, startOfLine); + if (match < 0) { + code = TCL_ERROR; + goto done; + } + if (!match) { + break; + } + Tcl_RegExpRange(regexp, 0, &start, &end); + i = start - startOfLine; + thisLength = end - start; + #endif /* KANJI */ + } + if (i >= lastChar) { + break; + } + matchChar = i; + matchLength = thisLength; + firstChar = matchChar+1; + } while (backwards); + + /* + * If we found a match then we're done. Make sure that + * the match occurred before the stopping index, if one was + * specified. + */ + + if (matchChar >= 0) { + /* + * The index information returned by the regular expression + * parser only considers textual information: it doesn't + * account for embedded windows or any other non-textual info. + * Scan through the line's segments again to adjust both + * matchChar and matchCount. + */ + + for (segPtr = linePtr->segPtr, leftToScan = matchChar; + leftToScan >= 0; segPtr = segPtr->nextPtr) { + if (segPtr->typePtr != &tkTextCharType) { + matchChar += segPtr->size; + continue; + } + leftToScan -= segPtr->size; + } + for (leftToScan += matchLength; leftToScan > 0; + segPtr = segPtr->nextPtr) { + if (segPtr->typePtr != &tkTextCharType) { + matchLength += segPtr->size; + continue; + } + leftToScan -= segPtr->size; + } + TkTextMakeIndex(textPtr->tree, lineNum, matchChar, &index); + if (!searchWholeText) { + if (!backwards && (TkTextIndexCmp(&index, &stopIndex) >= 0)) { + goto done; + } + if (backwards && (TkTextIndexCmp(&index, &stopIndex) < 0)) { + goto done; + } + } + if (varName != NULL) { + sprintf(buffer, "%d", matchLength); + if (Tcl_SetVar(interp, varName, buffer, TCL_LEAVE_ERR_MSG) + == NULL) { + code = TCL_ERROR; + goto done; + } + } + TkTextPrintIndex(&index, interp->result); + goto done; + } + + /* + * Go to the next (or previous) line; + */ + + nextLine: + if (backwards) { + lineNum--; + if (!searchWholeText) { + if (lineNum < stopLine) { + break; + } + } else if (lineNum < 0) { + lineNum = numLines-1; + } + } else { + lineNum++; + if (!searchWholeText) { + if (lineNum > stopLine) { + break; + } + } else if (lineNum >= numLines) { + lineNum = 0; + } + } + #ifdef KANJI + Tcl_DWStringSetLength(&line, 0); + #else + Tcl_DStringSetLength(&line, 0); + #endif /* KANJI */ + } + done: + #ifdef KANJI + Tcl_DWStringFree(&line); + if (noCase) { + Tcl_DWStringFree(&patDString); + } + Tk_FreeWStr(pPattern); + #else + Tcl_DStringFree(&line); + if (noCase) { + Tcl_DStringFree(&patDString); + } + #endif /* KANJI */ + return code; + } + #endif /* KANJI */ + /* *---------------------------------------------------------------------- * *************** *** 2103,2109 **** --- 2849,2861 ---- int result = TCL_OK; if ((what & TK_DUMP_TEXT) && (segPtr->typePtr == &tkTextCharType) && (offset + segPtr->size > start)) { + #ifdef KANJI + wchar savedChar; /* Last char used in the seg */ + int kanjiCode = Tcl_KanjiCode(interp); + char *str; + #else char savedChar; /* Last char used in the seg */ + #endif /* KANJI */ int last = segPtr->size; /* Index of savedChar */ int first = 0; /* Index of first char in seg */ if (offset + segPtr->size > end) { *************** *** 2114,2121 **** --- 2866,2882 ---- } savedChar = segPtr->body.chars[last]; segPtr->body.chars[last] = '\0'; + #ifdef KANJI + str = (char *) ckalloc((unsigned) + (Tcl_KanjiDecode(kanjiCode, segPtr->body.chars+first, NULL) + 1)); + (void) Tcl_KanjiDecode(kanjiCode, segPtr->body.chars+first, str); + result = DumpSegment(interp, "text", str, + command, lineno, offset + first, what); + ckfree(str); + #else result = DumpSegment(interp, "text", segPtr->body.chars + first, command, lineno, offset + first, what); + #endif /* KANJI */ segPtr->body.chars[last] = savedChar; } else if ((offset >= start)) { if ((what & TK_DUMP_MARK) && (segPtr->typePtr->name[0] == 'm')) { diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/generic/tkText.h ./generic/tkText.h *** ../tk4.2/generic/tkText.h Tue Aug 27 02:09:34 1996 --- ./generic/tkText.h Fri Oct 18 13:14:54 1996 *************** *** 122,130 **** --- 122,134 ---- int size; /* Size of this segment (# of bytes * of index space it occupies). */ union { + #ifdef KANJI + wchar chars[4]; + #else char chars[4]; /* Characters that make up character * info. Actual length varies to * hold as many characters as needed.*/ + #endif /* KANJI */ TkTextToggle toggle; /* Information about tag toggle. */ TkTextMark mark; /* Information about mark. */ TkTextEmbWindow ew; /* Information about embedded *************** *** 275,282 **** --- 279,291 ---- * means no value specified here. */ XColor *fgColor; /* Foreground color for text. NULL means * no value specified here. */ + #ifdef KANJI + XFontStruct *asciiFontPtr; + XFontStruct *kanjiFontPtr; + #else XFontStruct *fontPtr; /* Font for displaying text. NULL means * no value specified here. */ + #endif /* KANJI */ Pixmap fgStipple; /* Stipple bitmap for text and other * foreground stuff. None means no value * specified here.*/ *************** *** 458,464 **** --- 467,479 ---- XColor *highlightColorPtr; /* Color for drawing traversal highlight. */ Tk_Cursor cursor; /* Current cursor for window, or None. */ XColor *fgColor; /* Default foreground color for text. */ + #ifdef KANJI + XWSFontSet *fontPtr; + XFontStruct *asciiFontPtr; + XFontStruct *kanjiFontPtr; + #else XFontStruct *fontPtr; /* Default font for displaying text. */ + #endif /* KANJI */ int charWidth; /* Width of average character in default * font. */ int spacing1; /* Default extra spacing above first display *************** *** 802,807 **** --- 817,826 ---- char *name, TkTextIndex *indexPtr)); extern int TkTextXviewCmd _ANSI_ARGS_((TkText *textPtr, Tcl_Interp *interp, int argc, char **argv)); + #ifdef KINPUT2 + extern int TkTextXYPos _ANSI_ARGS_((Tcl_Interp *interp, + TkText *textPtr, TkTextIndex *indexPtr)); + #endif /* KINPUT2 */ extern int TkTextYviewCmd _ANSI_ARGS_((TkText *textPtr, Tcl_Interp *interp, int argc, char **argv)); diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/generic/tkTextBTree.c ./generic/tkTextBTree.c *** ../tk4.2/generic/tkTextBTree.c Tue Aug 27 02:09:26 1996 --- ./generic/tkTextBTree.c Fri Oct 18 13:14:55 1996 *************** *** 104,111 **** --- 104,116 ---- * Macros that determine how much space to allocate for new segments: */ + #ifdef KANJI + #define CSEG_SIZE(chars) ((unsigned) (Tk_Offset(TkTextSegment, body) \ + + (1 + (chars)) * sizeof(wchar))) + #else #define CSEG_SIZE(chars) ((unsigned) (Tk_Offset(TkTextSegment, body) \ + 1 + (chars))) + #endif /* KANJI */ #define TSEG_SIZE ((unsigned) (Tk_Offset(TkTextSegment, body) \ + sizeof(TkTextToggle))) *************** *** 408,417 **** --- 413,430 ---- register TkTextSegment *segPtr; TkTextLine *newLinePtr; int chunkSize; /* # characters in current chunk. */ + #ifdef KANJI + register wchar *eol; + #else register char *eol; /* Pointer to character just after last * one in current chunk. */ + #endif /* KANJI */ int changeToLineCount; /* Counts change to total number of * lines in file. */ + #ifdef KANJI + wchar *wstr = Tk_GetWStr(NULL, string); + #define string wstr + #endif /* KANJI */ prevPtr = SplitSeg(indexPtr); linePtr = indexPtr->linePtr; *************** *** 442,448 **** --- 455,465 ---- curPtr->nextPtr = segPtr; } segPtr->size = chunkSize; + #ifdef KANJI + Tcl_WStrncpy(segPtr->body.chars, wstr, (size_t) chunkSize); + #else strncpy(segPtr->body.chars, string, (size_t) chunkSize); + #endif /* KANJI */ segPtr->body.chars[chunkSize] = 0; curPtr = segPtr; *************** *** 496,501 **** --- 513,521 ---- if (tkBTreeDebug) { TkBTreeCheck(indexPtr->tree); } + #ifdef KANJI + #undef string + #endif /* KANJI */ } /* *************** *** 3232,3243 **** --- 3252,3271 ---- newPtr1->typePtr = &tkTextCharType; newPtr1->nextPtr = newPtr2; newPtr1->size = index; + #ifdef KANJI + Tcl_WStrncpy(newPtr1->body.chars, segPtr->body.chars, (size_t) index); + #else strncpy(newPtr1->body.chars, segPtr->body.chars, (size_t) index); + #endif /* KANJI */ newPtr1->body.chars[index] = 0; newPtr2->typePtr = &tkTextCharType; newPtr2->nextPtr = segPtr->nextPtr; newPtr2->size = segPtr->size - index; + #ifdef KANJI + Tcl_WStrcpy(newPtr2->body.chars, segPtr->body.chars + index); + #else strcpy(newPtr2->body.chars, segPtr->body.chars + index); + #endif /* KANJI */ ckfree((char*) segPtr); return newPtr1; } *************** *** 3279,3286 **** --- 3307,3319 ---- newPtr->typePtr = &tkTextCharType; newPtr->nextPtr = segPtr2->nextPtr; newPtr->size = segPtr->size + segPtr2->size; + #ifdef KANJI + Tcl_WStrcpy(newPtr->body.chars, segPtr->body.chars); + Tcl_WStrcpy(newPtr->body.chars + segPtr->size, segPtr2->body.chars); + #else strcpy(newPtr->body.chars, segPtr->body.chars); strcpy(newPtr->body.chars + segPtr->size, segPtr2->body.chars); + #endif /* KANJI */ ckfree((char*) segPtr); ckfree((char*) segPtr2); return newPtr; *************** *** 3350,3356 **** --- 3383,3393 ---- if (segPtr->size <= 0) { panic("CharCheckProc: segment has size <= 0"); } + #ifdef KANJI + if (Tcl_WStrlen(segPtr->body.chars) != segPtr->size) { + #else if (strlen(segPtr->body.chars) != segPtr->size) { + #endif /* KANJI */ panic("CharCheckProc: segment has wrong size"); } if (segPtr->nextPtr == NULL) { diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/generic/tkTextDisp.c ./generic/tkTextDisp.c *** ../tk4.2/generic/tkTextDisp.c Fri Sep 6 01:59:46 1996 --- ./generic/tkTextDisp.c Sun Nov 24 17:50:09 1996 *************** *** 18,23 **** --- 18,29 ---- #include "tkInt.h" #include "tkText.h" + #ifdef KANJI + #define TkMeasureChars TkMeasureWChars + #define TkDisplayChars TkDisplayWChars + #define TkUnderlineChars TkUnderlineWChars + #endif /* KANJI */ + /* * The following structure describes how to display a range of characters. * The information is generated by scanning all of the tags associated *************** *** 34,40 **** --- 40,50 ---- Pixmap bgStipple; /* Stipple bitmap for background. None * means draw solid. */ XColor *fgColor; /* Foreground color for text. */ + #ifdef KANJI + XWSFontSet *fontPtr; + #else XFontStruct *fontPtr; /* Font for displaying text. */ + #endif /* KANJI */ Pixmap fgStipple; /* Stipple bitmap for text and other * foreground stuff. None means draw * solid.*/ *************** *** 71,77 **** --- 81,91 ---- * referenced in Chunks. */ GC bgGC; /* Graphics context for background. None * means use widget background. */ + #ifdef KANJI + XWSGC fgGC; + #else GC fgGC; /* Graphics context for foreground. */ + #endif /* KANJI */ StyleValues *sValuePtr; /* Raw information from which GCs were * derived. */ Tcl_HashEntry *hPtr; /* Pointer to entry in styleTable. Used *************** *** 255,263 **** --- 269,281 ---- typedef struct CharInfo { int numChars; /* Number of characters to display. */ + #ifdef KANJI + wchar chars[4]; + #else char chars[4]; /* Characters to display. Actual size * will be numChars, not 4. THIS MUST BE * THE LAST FIELD IN THE STRUCTURE. */ + #endif /* KANJI */ } CharInfo; /* *************** *** 466,471 **** --- 484,493 ---- int numTags, new, i; XGCValues gcValues; unsigned long mask; + #ifdef KANJI + XFontStruct* asciiFontPtr = NULL; + XFontStruct* kanjiFontPtr = NULL; + #endif /* KANJI */ /* * The variables below keep track of the highest-priority specification *************** *** 478,483 **** --- 500,508 ---- int lMargin1Prio, lMargin2Prio, rMarginPrio; int spacing1Prio, spacing2Prio, spacing3Prio; int overstrikePrio, tabPrio, wrapPrio; + #ifdef KANJI + int asciiFontPrio, kanjiFontPrio; + #endif /* KANJI */ /* * Find out what tags are present for the character, then compute *************** *** 493,498 **** --- 518,526 ---- lMargin1Prio = lMargin2Prio = rMarginPrio = -1; spacing1Prio = spacing2Prio = spacing3Prio = -1; overstrikePrio = tabPrio = wrapPrio = -1; + #ifdef KANJI + asciiFontPrio = kanjiFontPrio = -1; + #endif /* KANJI */ memset((VOID *) &styleValues, 0, sizeof(StyleValues)); styleValues.relief = TK_RELIEF_FLAT; styleValues.fgColor = textPtr->fgColor; *************** *** 531,540 **** --- 559,579 ---- styleValues.fgColor = tagPtr->fgColor; fgPrio = tagPtr->priority; } + #ifdef KANJI + if ((tagPtr->asciiFontPtr != None) && (tagPtr->priority > asciiFontPrio)) { + asciiFontPtr = tagPtr->asciiFontPtr; + asciiFontPrio = tagPtr->priority; + } + if ((tagPtr->kanjiFontPtr != None) && (tagPtr->priority > kanjiFontPrio)) { + kanjiFontPtr = tagPtr->kanjiFontPtr; + kanjiFontPrio = tagPtr->priority; + } + #else if ((tagPtr->fontPtr != None) && (tagPtr->priority > fontPrio)) { styleValues.fontPtr = tagPtr->fontPtr; fontPrio = tagPtr->priority; } + #endif /* KANJI */ if ((tagPtr->fgStipple != None) && (tagPtr->priority > fgStipplePrio)) { styleValues.fgStipple = tagPtr->fgStipple; *************** *** 605,610 **** --- 644,665 ---- ckfree((char *) tagPtrs); } + #ifdef KANJI + /* + * Get a font set from asciiFontPtr and kanjiFontPtr. + * If one or both of the fonts are not specified in tags, use default. + */ + if (asciiFontPtr == NULL) { + char *name = Tk_NameOfFontStruct(textPtr->asciiFontPtr); + asciiFontPtr = Tk_GetFontStruct(textPtr->interp, textPtr->tkwin, Tk_GetUid(name)); + } + if (kanjiFontPtr == NULL) { + char *name = Tk_NameOfFontStruct(textPtr->kanjiFontPtr); + kanjiFontPtr = Tk_GetFontStruct(textPtr->interp, textPtr->tkwin, Tk_GetUid(name)); + } + styleValues.fontPtr = Tk_GetFontSet(asciiFontPtr, kanjiFontPtr); + #endif /* KANJI */ + /* * Use an existing style if there's one around that matches. */ *************** *** 637,649 **** --- 692,710 ---- } mask = GCForeground|GCFont; gcValues.foreground = styleValues.fgColor->pixel; + #ifndef KANJI gcValues.font = styleValues.fontPtr->fid; + #endif /* !KANJI */ if (styleValues.fgStipple != None) { gcValues.stipple = styleValues.fgStipple; gcValues.fill_style = FillStippled; mask |= GCStipple|GCFillStyle; } + #ifdef KANJI + stylePtr->fgGC = Tk_GetGCSet(textPtr->tkwin, mask, &gcValues, styleValues.fontPtr); + #else stylePtr->fgGC = Tk_GetGC(textPtr->tkwin, mask, &gcValues); + #endif /* KANJI */ stylePtr->sValuePtr = (StyleValues *) Tcl_GetHashKey(&textPtr->dInfoPtr->styleTable, hPtr); stylePtr->hPtr = hPtr; *************** *** 681,687 **** --- 742,752 ---- if (stylePtr->bgGC != None) { Tk_FreeGC(textPtr->display, stylePtr->bgGC); } + #ifdef KANJI + Tk_FreeGCSet(textPtr->display, stylePtr->fgGC); + #else Tk_FreeGC(textPtr->display, stylePtr->fgGC); + #endif /* KANJI */ Tcl_DeleteHashEntry(stylePtr->hPtr); ckfree((char *) stylePtr); } *************** *** 849,855 **** --- 914,924 ---- maxChars = segPtr->size - offset; if (justify == TK_JUSTIFY_LEFT) { if (segPtr->typePtr == &tkTextCharType) { + #ifdef KANJI + wchar *p; + #else char *p; + #endif /* KANJI */ for (p = segPtr->body.chars + offset; *p != 0; p++) { if (*p == '\t') { *************** *** 4202,4211 **** --- 4271,4288 ---- * about this chunk. The x field has already * been set by the caller. */ { + #ifdef KANJI + XWSFontSet *fontPtr; + #else XFontStruct *fontPtr; + #endif /* KANJI */ int nextX, charsThatFit, count; CharInfo *ciPtr; + #ifdef KANJI + wchar *p; + #else char *p; + #endif /* KANJI */ TkTextSegment *nextPtr; /* *************** *** 4272,4282 **** --- 4349,4368 ---- chunkPtr->minHeight = 0; chunkPtr->width = nextX - chunkPtr->x; chunkPtr->breakIndex = -1; + #ifdef KANJI + ciPtr = (CharInfo *) ckalloc((unsigned) + (sizeof(CharInfo) + (charsThatFit - 3) * sizeof(wchar))); + #else ciPtr = (CharInfo *) ckalloc((unsigned) (sizeof(CharInfo) - 3 + charsThatFit)); + #endif /* KANJI */ chunkPtr->clientData = (ClientData) ciPtr; ciPtr->numChars = charsThatFit; + #ifdef KANJI + Tcl_WStrncpy(ciPtr->chars, p, (size_t) charsThatFit); + #else strncpy(ciPtr->chars, p, (size_t) charsThatFit); + #endif /* KANJI */ if (p[charsThatFit-1] == '\n' || p[charsThatFit-1] == '\r') { ciPtr->numChars--; } *************** *** 4293,4299 **** --- 4379,4389 ---- } else { for (count = charsThatFit, p += charsThatFit-1; count > 0; count--, p--) { + #ifdef KANJI + if (ISWSPACE(*p)) { + #else if (isspace(UCHAR(*p))) { + #endif /* KANJI */ chunkPtr->breakIndex = count; break; } *************** *** 4587,4593 **** --- 4677,4689 ---- CharInfo *ciPtr = NULL; /* Initialization needed only to * prevent compiler warnings. */ int tabX, prev, spaceWidth; + #ifdef KANJI + wchar *p; + static wchar wtab = '\t'; + static wchar wspace = ' '; + #else char *p; + #endif /* KANJI */ TkTextTabAlign alignment; if (chunkPtr->nextPtr == NULL) { *************** *** 4610,4616 **** --- 4706,4716 ---- * interpretation of tabs. */ + #ifdef KANJI + TkMeasureChars(textPtr->fontPtr, &wtab, 1, x, INT_MAX, 0, 0, &desired); + #else TkMeasureChars(textPtr->fontPtr, "\t", 1, x, INT_MAX, 0, 0, &desired); + #endif /* KANJI */ goto update; } *************** *** 4674,4680 **** --- 4774,4784 ---- } ciPtr = (CharInfo *) chunkPtr2->clientData; for (p = ciPtr->chars, i = 0; i < ciPtr->numChars; p++, i++) { + #ifdef KANJI + if (ISWDIGIT(*p)) { + #else if (isdigit(UCHAR(*p))) { + #endif /* KANJI */ gotDigit = 1; } else if ((*p == '.') || (*p == ',')) { decimal = p-ciPtr->chars; *************** *** 4720,4726 **** --- 4824,4834 ---- update: delta = desired - x; + #ifdef KANJI + TkMeasureChars(textPtr->fontPtr, &wspace, 1, 0, INT_MAX, 0, 0, &spaceWidth); + #else TkMeasureChars(textPtr->fontPtr, " ", 1, 0, INT_MAX, 0, 0, &spaceWidth); + #endif /* KANJI */ if (delta < spaceWidth) { delta = spaceWidth; } *************** *** 4768,4776 **** --- 4876,4892 ---- { int tabX, prev, result, spaceWidth; TkTextTabAlign alignment; + #ifdef KANJI + static wchar wtab = '\t'; + static wchar wspace = ' '; + #endif /* KANJI */ if ((tabArrayPtr == NULL) || (tabArrayPtr->numTabs == 0)) { + #ifdef KANJI + TkMeasureChars(textPtr->fontPtr, &wtab, 1, x, INT_MAX, 0, 0, &tabX); + #else TkMeasureChars(textPtr->fontPtr, "\t", 1, x, INT_MAX, 0, 0, &tabX); + #endif /* KANJI */ return tabX - x; } if (index < tabArrayPtr->numTabs) { *************** *** 4825,4833 **** --- 4941,5014 ---- } done: + #ifdef KANJI + TkMeasureChars(textPtr->fontPtr, &wspace, 1, 0, INT_MAX, 0, 0, &spaceWidth); + #else TkMeasureChars(textPtr->fontPtr, " ", 1, 0, INT_MAX, 0, 0, &spaceWidth); + #endif /* KANJI */ if (result < spaceWidth) { result = spaceWidth; } return result; } + + #ifdef KINPUT2 + /* + *-------------------------------------------------------------- + * + * TkTextXYPos -- + * + * This procedure returns XY coordinates of the point + * specified by its line and character index. + * The Y coordinate is of the baseline of the line + * on which the point is. + * + * Results: + * The return value is always TCL_OK (i.e. no errors possible). + * If the point is visible, this procedure will return a list + * containing its X and Y position. Othewise, an empty string + * will be returned. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + + int + TkTextXYPos(interp, textPtr, indexPtr) + Tcl_Interp *interp; /* For the result */ + TkText *textPtr; /* Text for which the index is being + * specified. */ + TkTextIndex *indexPtr; /* Character index for which its position + * is to be retrieved. */ + { + register TkTextDispChunk *chunkPtr; + TextDInfo *dInfoPtr = textPtr->dInfoPtr; + DLine *dlPtr; + int x, y; + + /* + * Make sure that all of the layout information about what's + * displayed where on the screen is up-to-date. + */ + if (dInfoPtr->flags & DINFO_OUT_OF_DATE) { + UpdateDisplayInfo(textPtr); + } + + dlPtr = FindDLine(dInfoPtr->dLinePtr, indexPtr); + if (dlPtr == NULL) return TCL_OK; + + for (chunkPtr = dlPtr->chunkPtr; (chunkPtr != NULL); + chunkPtr = chunkPtr->nextPtr) { + if (chunkPtr->displayProc == TkTextInsertDisplayProc) { + x = chunkPtr->x + dInfoPtr->x - dInfoPtr->curPixelOffset; + y = dlPtr->y + dlPtr->baseline; + sprintf(interp->result, "%d %d", x, y); + return TCL_OK; + } + } + + return TCL_OK; + } + #endif /* KINPUT2 */ diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/generic/tkTextIndex.c ./generic/tkTextIndex.c *** ../tk4.2/generic/tkTextIndex.c Tue Aug 27 02:09:27 1996 --- ./generic/tkTextIndex.c Fri Oct 18 13:14:57 1996 *************** *** 736,742 **** --- 736,747 ---- TkTextIndex *indexPtr; /* Index to mdoify based on string. */ { char *p; + #ifdef KANJI + wchar c; + int offset; + #else int c, offset; + #endif /* KANJI */ size_t length; register TkTextSegment *segPtr; *************** *** 773,779 **** --- 778,788 ---- while (1) { if (segPtr->typePtr == &tkTextCharType) { c = segPtr->body.chars[offset]; + #ifdef KANJI + if (!ISWALNUM(c) && (c != '_')) { + #else if (!isalnum(UCHAR(c)) && (c != '_')) { + #endif /* KANJI */ break; } firstChar = 0; *************** *** 802,808 **** --- 811,821 ---- while (1) { if (segPtr->typePtr == &tkTextCharType) { c = segPtr->body.chars[offset]; + #ifdef KANJI + if (!ISWALNUM(c) && (c != '_')) { + #else if (!isalnum(UCHAR(c)) && (c != '_')) { + #endif /* KANJI */ break; } firstChar = 0; diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/generic/tkTextTag.c ./generic/tkTextTag.c *** ../tk4.2/generic/tkTextTag.c Tue Aug 27 02:09:28 1996 --- ./generic/tkTextTag.c Fri Oct 18 13:14:58 1996 *************** *** 33,40 **** --- 33,47 ---- TK_CONFIG_DONT_SET_DEFAULT|TK_CONFIG_NULL_OK}, {TK_CONFIG_BITMAP, "-fgstipple", (char *) NULL, (char *) NULL, (char *) NULL, Tk_Offset(TkTextTag, fgStipple), TK_CONFIG_NULL_OK}, + #ifdef KANJI + {TK_CONFIG_FONT, "-font", (char *) NULL, (char *) NULL, + (char *) NULL, Tk_Offset(TkTextTag, asciiFontPtr), TK_CONFIG_NULL_OK}, + {TK_CONFIG_FONT, "-kanjifont", (char *) NULL, (char *) NULL, + (char *) NULL, Tk_Offset(TkTextTag, kanjiFontPtr), TK_CONFIG_NULL_OK}, + #else {TK_CONFIG_FONT, "-font", (char *) NULL, (char *) NULL, (char *) NULL, Tk_Offset(TkTextTag, fontPtr), TK_CONFIG_NULL_OK}, + #endif /* KANJI */ {TK_CONFIG_COLOR, "-foreground", (char *) NULL, (char *) NULL, (char *) NULL, Tk_Offset(TkTextTag, fgColor), TK_CONFIG_NULL_OK}, {TK_CONFIG_STRING, "-justify", (char *) NULL, (char *) NULL, *************** *** 406,412 **** --- 413,425 ---- || (tagPtr->bdString != NULL) || (tagPtr->reliefString != NULL) || (tagPtr->bgStipple != None) + #ifdef KANJI + || (tagPtr->fgColor != NULL) + || (tagPtr->asciiFontPtr != NULL) + || (tagPtr->kanjiFontPtr != NULL) + #else || (tagPtr->fgColor != NULL) || (tagPtr->fontPtr != None) + #endif /* KANJI */ || (tagPtr->fgStipple != None) || (tagPtr->justifyString != NULL) || (tagPtr->lMargin1String != NULL) *************** *** 787,793 **** --- 800,811 ---- tagPtr->relief = TK_RELIEF_FLAT; tagPtr->bgStipple = None; tagPtr->fgColor = NULL; + #ifdef KANJI + tagPtr->asciiFontPtr = NULL; + tagPtr->kanjiFontPtr = NULL; + #else tagPtr->fontPtr = NULL; + #endif /* KANJI */ tagPtr->fgStipple = None; tagPtr->justifyString = NULL; tagPtr->justify = TK_JUSTIFY_LEFT; *************** *** 895,903 **** --- 913,930 ---- if (tagPtr->fgColor != None) { Tk_FreeColor(tagPtr->fgColor); } + #ifdef KANJI + if (tagPtr->asciiFontPtr != NULL ) { + Tk_FreeFontStruct(tagPtr->asciiFontPtr); + } + if (tagPtr->kanjiFontPtr != NULL ) { + Tk_FreeFontStruct(tagPtr->kanjiFontPtr); + } + #else if (tagPtr->fontPtr != None) { Tk_FreeFontStruct(tagPtr->fontPtr); } + #endif /* KANJI */ if (tagPtr->fgStipple != None) { Tk_FreeBitmap(textPtr->display, tagPtr->fgStipple); } diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/generic/tkWStr.c ./generic/tkWStr.c *** ../tk4.2/generic/tkWStr.c Thu Jan 1 09:00:00 1970 --- ./generic/tkWStr.c Fri Oct 18 13:14:58 1996 *************** *** 0 **** --- 1,1128 ---- + /* + * tkWStr.c -- + * + * This file contains a collection of procedures that are used + * to handle the wide strings. + * + * Copyright 1988,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. + */ + + #ifndef lint + static char rcsid[] = "$Header: /ext/cvsroot/tk/generic/tkWStr.c,v 1.3 1996/07/05 02:14:02 nisinaka Exp $"; + #endif + + #ifdef KANJI + + #include "tkPort.h" + #include "tkInt.h" + + /* + * One of the following data structures exists for each font set that is + * currently active. The structure is indexed with two hash tables, + * one based on font name and one based on XFontStruct address. + */ + + typedef struct { + XWSFontSet *fontset; + int refCount; + Tcl_HashEntry *fontsetHashPtr; + } TkFontSet; + + /* + * Hash table for asciiFont & kanjiFont -> TkFontSet mapping, + * and key structure used to index into that table: + */ + + static Tcl_HashTable fontsetTable; + typedef struct { + XFontStruct *asciiFontPtr; + XFontStruct *kanjiFontPtr; + } FontSetKey; + + /* + * Hash table for font struct -> TkFont mapping. This table is + * indexed by the XFontStruct address. + */ + + static Tcl_HashTable fs_idTable; + + static int fs_initialized = 0; /* 0 means static structures haven't been + * initialized yet. */ + + + /* + * One of the following data structures exists for each GCSet that is + * currently active. The structure is indexed with two hash tables, + * one based on font name and one based on XFontStruct address. + */ + + typedef struct { + XWSGC gcset; /* GCSet */ + int refCount; /* Number of active uses of gc. */ + Tcl_HashEntry *gcsetHashPtr;/* Entry in gcsetTable (needed when deleting + * this structure). */ + } TkGCSet; + + /* + * Hash table to map from a GCSet's values to a TkGCSet structure describing + * a GCSet with those values (used by Tk_GetGCSet). + */ + + static Tcl_HashTable gcsetTable; + typedef struct { + XWSFontSet *fontset; /* Desired values for XWSFontSet. */ + GC asciiGC; /* Desired values for GC with ascii font. */ + GC kanjiGC; /* Desired values for GC with kanji font. */ + } GCSetKey; + + /* + * Hash table for GCSet -> TkGCSet mapping. This table is indexed by the + * GCSet identifier, and is used by Tk_FreeGCSet. + */ + + static Tcl_HashTable gs_idTable; + + static int gs_initialized = 0; /* 0 means static structures haven't been + * initialized yet. */ + + /* + * One of the following data structures exists for each font set that is + * currently active. The structure is indexed with two hash tables, + * one based on font name and one based on XFontStruct address. + */ + + typedef struct { + int kanjiCode; + char *str; + wchar *wstr; + int refCount; + Tcl_HashEntry *wstrHashPtr; + } TkWStr; + + /* + * Hash table to map from a wide string's values to a TkWStr structure + * describing a wide string with those values (used by Tk_GetWStr). + */ + + static Tcl_HashTable wstrTable; + + /* + * Hash table for wchar -> TkWStr mapping. This table is indexed by the + * wchar identifier, and is used by Tk_FreeWStr. + */ + + static Tcl_HashTable ws_idTable; + + static int ws_initialized = 0; /* 0 means static structures haven't been + * initialized yet. */ + + /* + * Trivial yet useful macros. + */ + #define MIN(a, b) ((a) > (b) ? (b) : (a)) + #define MAX(a, b) ((a) > (b) ? (a) : (b)) + + /* + * Forward declarations for procedures defined in this file: + */ + + static void FontSetInit _ANSI_ARGS_((void)); + static void GCSetInit _ANSI_ARGS_((void)); + static void WStrInit _ANSI_ARGS_((void)); + static int wsdrawstring _ANSI_ARGS_ ((Display *display, + Drawable drawable, XWSGC gcset, + int x, int y, wchar *wstring, int length)); + static int flushstr _ANSI_ARGS_ ((Display *display, + Drawable drawable, FontEnt *fe, + int x, int y, + XChar2b *cp0, XChar2b *cp1)); + + /* + *---------------------------------------------------------------------- + * + * Tk_GetFontSet -- + * + * Given two XFontStruct *, asciiFontPtr & kanjiFontPtr, map them + * to an XWSFontSet describing the font set. + * + * Results: + * The return value is normally a pointer to the font set description + * for the desired font set. + * + * Side effects: + * The font set is added to an internal database with a reference count. + * For each call to this procedure, there should eventually be a call + * to Tk_FreeFontSet, so that the database is cleaned up when fonts + * aren't in use anymore. + * + *---------------------------------------------------------------------- + */ + XWSFontSet * + Tk_GetFontSet(asciiFontPtr, kanjiFontPtr) + XFontStruct *asciiFontPtr; + XFontStruct *kanjiFontPtr; + { + FontSetKey key; + Tcl_HashEntry *fontsetHashPtr, *idHashPtr; + register TkFontSet *fontsetPtr; + int new; + + + if( !fs_initialized ) FontSetInit(); + + /* + * First, check to see if there's already a mapping for this font + * set. + */ + + key.asciiFontPtr = asciiFontPtr; + key.kanjiFontPtr = kanjiFontPtr; + + fontsetHashPtr = Tcl_CreateHashEntry(&fontsetTable, (char *)&key, &new); + if( !new ) { + fontsetPtr = (TkFontSet *)Tcl_GetHashValue(fontsetHashPtr); + fontsetPtr->refCount++; + return( fontsetPtr->fontset ); + } + + /* + * The font set isn't currently known. Map from the asciiFont & + * kanjiFont to a font set, and add a new structure to the database. + */ + + fontsetPtr = (TkFontSet *)ckalloc(sizeof(TkFontSet)); + fontsetPtr->fontset = (XWSFontSet *)ckalloc(sizeof(XWSFontSet)); + fontsetPtr->fontset->asciiFont = asciiFontPtr; + fontsetPtr->fontset->kanjiFont = kanjiFontPtr; + fontsetPtr->fontset->min_bounds.width + = MIN(asciiFontPtr->min_bounds.width, kanjiFontPtr->min_bounds.width); + fontsetPtr->fontset->min_bounds.rbearing + = MIN(asciiFontPtr->min_bounds.rbearing, kanjiFontPtr->min_bounds.rbearing); + fontsetPtr->fontset->max_bounds.descent + = MAX(asciiFontPtr->max_bounds.descent, kanjiFontPtr->max_bounds.descent); + fontsetPtr->fontset->max_bounds.lbearing + = MAX(asciiFontPtr->max_bounds.lbearing, kanjiFontPtr->max_bounds.lbearing); + fontsetPtr->fontset->max_bounds.rbearing + = MAX(asciiFontPtr->max_bounds.rbearing, kanjiFontPtr->max_bounds.rbearing); + fontsetPtr->fontset->ascent + = MAX(asciiFontPtr->ascent, kanjiFontPtr->ascent); + fontsetPtr->fontset->descent + = MAX(asciiFontPtr->descent, kanjiFontPtr->descent); + fontsetPtr->refCount = 1; + fontsetPtr->fontsetHashPtr = fontsetHashPtr; + idHashPtr = Tcl_CreateHashEntry(&fs_idTable, (char *)fontsetPtr->fontset, &new); + if( !new ) { + panic("FontSet already registered in Tk_GetFontSet"); + } + Tcl_SetHashValue(fontsetHashPtr, fontsetPtr); + Tcl_SetHashValue(idHashPtr, fontsetPtr); + + return( fontsetPtr->fontset ); + } + + /* + *---------------------------------------------------------------------- + * + * Tk_FreeFontSet -- + * + * This procedure is called to release a font set allocated by + * Tk_GetFontSet. + * + * Results: + * None. + * + * Side effects: + * The reference count associated with font set is decremented, + * and the font set is officially deallocated if no-one is using + * it anymore. + * + *---------------------------------------------------------------------- + */ + void + Tk_FreeFontSet(fontset) + XWSFontSet *fontset; + { + Tcl_HashEntry *idHashPtr; + register TkFontSet *fontsetPtr; + + if( !fs_initialized ) panic("Tk_FreeFontSet called before Tk_GetFontSet"); + + idHashPtr = Tcl_FindHashEntry(&fs_idTable, (char *)fontset); + if( idHashPtr == NULL ) { + panic("Tk_FreeFontSet received unknown fontset argument"); + } + fontsetPtr = (TkFontSet *)Tcl_GetHashValue(idHashPtr); + fontsetPtr->refCount--; + if( fontsetPtr->refCount == 0 ) { + ckfree((char *)fontsetPtr->fontset); + Tcl_DeleteHashEntry(fontsetPtr->fontsetHashPtr); + Tcl_DeleteHashEntry(idHashPtr); + ckfree((char *)fontsetPtr); + } + } + + /* + *---------------------------------------------------------------------- + * + * FontSetInit -- + * + * Initialize the structures used for FontSet management. + * + * Results: + * None. + * + * Side effects: + * Read the code. + * + *---------------------------------------------------------------------- + */ + + static void + FontSetInit() + { + fs_initialized = 1; + Tcl_InitHashTable(&fontsetTable, sizeof(FontSetKey)/sizeof(int)); + Tcl_InitHashTable(&fs_idTable, TCL_ONE_WORD_KEYS); + } + + /* + *---------------------------------------------------------------------- + * + * Tk_GetGCSet -- + * + * Given a desired set of values for a graphics context, find + * a read-only GCSet with the desired values. + * + * Results: + * The return value is the XWSGC which describes GCSet. + * The caller should never modify this GCSet, and should + * call Tk_FreeGCSet when the GCSet is no longer needed. + * + * Side effects: + * The GCSet is added to an internal database with a reference count. + * For each call to this procedure, there should eventually be a call + * to Tk_FreeGCSet, so that the database can be cleaned up when + * GCSet's aren't needed anymore. + * + *---------------------------------------------------------------------- + */ + XWSGC + Tk_GetGCSet(tkwin, valueMask, valuePtr, fontset) + Tk_Window tkwin; + register unsigned long valueMask; + register XGCValues *valuePtr; + register XWSFontSet *fontset; + { + GCSetKey key; + Tcl_HashEntry *gcsetHashPtr, *idHashPtr; + register TkGCSet *gcsetPtr; + XGCValues value; + int new; + + if( !gs_initialized ) GCSetInit(); + + /* + * First, check to see if there's already a GCSet that will work + * for this request (exact matches only, sorry). + */ + + key.fontset = fontset; + value = *valuePtr; + valueMask |= GCFont; + value.font = fontset->asciiFont->fid; + key.asciiGC = Tk_GetGC(tkwin, valueMask, &value); + value.font = fontset->kanjiFont->fid; + key.kanjiGC = Tk_GetGC(tkwin, valueMask, &value); + + gcsetHashPtr = Tcl_CreateHashEntry(&gcsetTable, (char *)&key, &new); + if( !new ) { + gcsetPtr = (TkGCSet *)Tcl_GetHashValue(gcsetHashPtr); + gcsetPtr->refCount++; + return( gcsetPtr->gcset ); + } + + /* + * No GCSet is currently available for this set of values. Allocate a + * new GC and add a new structure to the database. + */ + + gcsetPtr = (TkGCSet *)ckalloc(sizeof(TkGCSet)); + gcsetPtr->gcset = (XWSGC )ckalloc(sizeof(XWSGCSet)); + gcsetPtr->gcset->fe[0].font = fontset->asciiFont; + gcsetPtr->gcset->fe[0].gc = key.asciiGC; + gcsetPtr->gcset->fe[0].flag = TK_GCCREAT + | ( IS2B(fontset->asciiFont) ? TK_TWOB : 0 ); + gcsetPtr->gcset->fe[1].font = fontset->kanjiFont; + gcsetPtr->gcset->fe[1].gc = key.kanjiGC; + gcsetPtr->gcset->fe[1].flag = TK_GCCREAT + | ( IS2B(fontset->kanjiFont) ? TK_TWOB : 0 ); + if (fontset->kanjiFont->min_byte1 > 0x80) { + /* GR encoding -- all the character codes have their 8th bit on */ + gcsetPtr->gcset->fe[1].flag |= TK_GRMAPPING; + } + gcsetPtr->gcset->fe[2].font = NULL; + gcsetPtr->gcset->fe[3].font = NULL; + gcsetPtr->refCount = 1; + gcsetPtr->gcsetHashPtr = gcsetHashPtr; + idHashPtr = Tcl_CreateHashEntry(&gs_idTable, (char *)gcsetPtr->gcset, &new); + if( !new ) { + panic("GCSet already registered in Tk_GetGCSet"); + } + Tcl_SetHashValue(gcsetHashPtr, gcsetPtr); + Tcl_SetHashValue(idHashPtr, gcsetPtr); + + return( gcsetPtr->gcset ); + } + + /* + *---------------------------------------------------------------------- + * + * Tk_FreeGCSet -- + * + * This procedure is called to release a GCSet allocated by + * Tk_GetGCSet. + * + * Results: + * None. + * + * Side effects: + * The reference count associated with gcset is decremented, and + * gcset is officially deallocated if no-one is using it anymore. + * + *---------------------------------------------------------------------- + */ + void + Tk_FreeGCSet(display, gcset) + Display *display; /* Display for which gc was allocated. */ + XWSGC gcset; /* Graphics context to be released. */ + { + Tcl_HashEntry *idHashPtr; + register TkGCSet *gcsetPtr; + + if( !gs_initialized ) panic("Tk_FreeGC called before Tk_GetGC"); + + idHashPtr = Tcl_FindHashEntry(&gs_idTable, (char *)gcset); + if( idHashPtr == NULL ) { + panic("Tk_FreeGCSet received unknown gcset argument"); + } + gcsetPtr = (TkGCSet *)Tcl_GetHashValue(idHashPtr); + gcsetPtr->refCount--; + if( gcsetPtr->refCount == 0 ) { + if( gcsetPtr->gcset->fe[0].flag & TK_GCCREAT ) { + Tk_FreeGC(display, gcsetPtr->gcset->fe[0].gc); + } + if( gcsetPtr->gcset->fe[1].flag & TK_GCCREAT ) { + Tk_FreeGC(display, gcsetPtr->gcset->fe[1].gc); + } + ckfree((char *)gcsetPtr->gcset); + Tcl_DeleteHashEntry(gcsetPtr->gcsetHashPtr); + Tcl_DeleteHashEntry(idHashPtr); + ckfree((char *)gcsetPtr); + } + } + + /* + *---------------------------------------------------------------------- + * + * GCSetInit -- + * + * Initialize the structures used for GCSet management. + * + * Results: + * None. + * + * Side effects: + * Read the code. + * + *---------------------------------------------------------------------- + */ + + static void + GCSetInit() + { + gs_initialized = 1; + Tcl_InitHashTable(&gcsetTable, sizeof(GCSetKey)/sizeof(int)); + Tcl_InitHashTable(&gs_idTable, TCL_ONE_WORD_KEYS); + } + + /* + *---------------------------------------------------------------------- + * + * Tk_GetWStr -- + * + * Given a string, map them to a wide string. + * + * Results: + * The return value is normally a pointer to the wide string. + * + * Side effects: + * The wide string is added to an internal database with a reference + * count. For each call to this procedure, there should eventually + * be a call to Tk_FreeWStr, so that the database is cleaned up when + * wide strings aren't in use anymore. + * + *---------------------------------------------------------------------- + */ + wchar * + Tk_GetWStr(interp, str) + Tcl_Interp *interp; + char *str; + { + Tcl_HashEntry *wstrHashPtr; + int new; + TkWStr *wstrPtr; + Tcl_HashEntry *idHashPtr; + int kanjiCode; + int length; + + if (!ws_initialized) WStrInit(); + + /* + * Get the kanji encoding information. + */ + if (interp != NULL) { + kanjiCode = Tcl_KanjiCode(interp); + } else { + (void) Tcl_KanjiString(NULL, str, &kanjiCode); + } + + + /* + * First, check to see if there's already a mapping for this string. + */ + + wstrHashPtr = Tcl_CreateHashEntry(&wstrTable, str, &new); + if (!new) { + wstrPtr = (TkWStr *)Tcl_GetHashValue(wstrHashPtr); + wstrPtr->refCount++; + return wstrPtr->wstr; + } + + /* + * The string isn't currently known. Map from the string to + * a wide string, and add a new structure to the database. + */ + + wstrPtr = (TkWStr *) ckalloc(sizeof(TkWStr)); + wstrPtr->kanjiCode = kanjiCode; + wstrPtr->str = ckalloc((unsigned)(strlen(str) + 1)); + strcpy(wstrPtr->str, str); + length = Tcl_KanjiEncode(kanjiCode, str, NULL); + wstrPtr->wstr = (wchar *) ckalloc((unsigned)(length + 1) * sizeof(wchar)); + (void) Tcl_KanjiEncode(kanjiCode, str, wstrPtr->wstr); + wstrPtr->refCount = 1; + wstrPtr->wstrHashPtr = wstrHashPtr; + idHashPtr = Tcl_CreateHashEntry(&ws_idTable, (char *)wstrPtr->wstr, &new); + if (!new) { + panic("wstr already registered in Tk_GetWStr"); + } + Tcl_SetHashValue(wstrHashPtr, wstrPtr); + Tcl_SetHashValue(idHashPtr, wstrPtr); + + return wstrPtr->wstr; + } + + /* + *---------------------------------------------------------------------- + * + * Tk_FreeWStr -- + * + * This procedure is called to release a wide string allocated + * by Tk_GetWStr. + * + * Results: + * None. + * + * Side effects: + * The reference count associated with wstr is decremented, and + * wstr is officially deallocated if no-one is using it anymore. + * + *---------------------------------------------------------------------- + */ + void + Tk_FreeWStr(wstr) + wchar *wstr; + { + Tcl_HashEntry *idHashPtr; + register TkWStr *wstrPtr; + + if( !ws_initialized ) panic("Tk_FreeWStr called before Tk_GetWStr"); + + idHashPtr = Tcl_FindHashEntry(&ws_idTable, (char *)wstr); + if( idHashPtr == NULL ) { + panic("Tk_FreeWStr received unknown wstr argument"); + } + wstrPtr = (TkWStr *)Tcl_GetHashValue(idHashPtr); + wstrPtr->refCount--; + if( wstrPtr->refCount == 0 ) { + ckfree((char *)wstrPtr->str); + ckfree((char *)wstrPtr->wstr); + Tcl_DeleteHashEntry(wstrPtr->wstrHashPtr); + Tcl_DeleteHashEntry(idHashPtr); + ckfree((char *)wstrPtr); + } + } + + /* + *---------------------------------------------------------------------- + * + * Tk_InsertWStr -- + * + * This procedure is called to modify the existing wide + * string by inserting characters. + * + * Results: + * The return value is a pointer to the wide string. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + wchar * + Tk_InsertWStr(interp, orig, index, wstr) + Tcl_Interp *interp; + wchar *orig; + int index; + wchar *wstr; + { + int origLen, wstrLen; + wchar *newstr; + register int kanjiCode = Tcl_KanjiCode(interp); + char *str; + int length, new; + Tcl_HashEntry *wstrHashPtr; + register TkWStr *wstrPtr; + Tcl_HashEntry *idHashPtr; + + if (!ws_initialized) panic("Tk_InsertWStr called before Tk_GetWStr"); + + origLen = Tcl_WStrlen(orig); + wstrLen = Tcl_WStrlen(wstr); + newstr = (wchar *) ckalloc((unsigned)(origLen + wstrLen + 1) * sizeof(wchar)); + Tcl_WStrncpy(newstr, orig, index); + Tcl_WStrcpy(newstr+index, wstr); + Tcl_WStrcpy(newstr+index+wstrLen, orig+index); + + /* + * Check if there's already a mapping for this string. + */ + length = Tcl_KanjiDecode(kanjiCode, newstr, NULL); + str = (char *) ckalloc((unsigned)(length + 1)); + (void) Tcl_KanjiDecode(kanjiCode, newstr, str); + + wstrHashPtr = Tcl_CreateHashEntry(&wstrTable, str, &new); + if (!new) { + wstrPtr = (TkWStr *) Tcl_GetHashValue(wstrHashPtr); + wstrPtr->refCount++; + Tk_FreeWStr(orig); + ckfree((char *) newstr); + ckfree(str); + return wstrPtr->wstr; + } + + /* + * The string isn't currently known. Map from the string to + * a wide string, and add a new structure to the database. + */ + wstrPtr = (TkWStr *) ckalloc(sizeof(TkWStr)); + wstrPtr->kanjiCode = kanjiCode; + wstrPtr->str = str; + wstrPtr->wstr = newstr; + wstrPtr->refCount = 1; + wstrPtr->wstrHashPtr = wstrHashPtr; + idHashPtr = Tcl_CreateHashEntry(&ws_idTable, (char *)wstrPtr->wstr, &new); + if (!new) { + panic("wstr already registered in Tk_InsertWStr"); + } + Tcl_SetHashValue(wstrPtr->wstrHashPtr, wstrPtr); + Tcl_SetHashValue(idHashPtr, wstrPtr); + + Tk_FreeWStr(orig); + return wstrPtr->wstr; + } + + /* + *---------------------------------------------------------------------- + * + * Tk_DeleteWStr -- + * + * This procedure is called to modify the existing wide + * string by deleting characters. + * + * Results: + * The return value is a pointer to the wide string. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + wchar * + Tk_DeleteWStr(interp, orig, index, count) + Tcl_Interp *interp; + wchar *orig; + int index; + int count; + { + int length; + wchar *newstr; + register int kanjiCode = Tcl_KanjiCode(interp); + char *str; + Tcl_HashEntry *wstrHashPtr; + register TkWStr *wstrPtr; + Tcl_HashEntry *idHashPtr; + int new; + + if (!ws_initialized) panic("Tk_InsertWStr called before Tk_GetWStr"); + + length = Tcl_WStrlen(orig); + newstr = (wchar *) ckalloc((unsigned)(length - count + 1) * sizeof(wchar)); + Tcl_WStrncpy(newstr, orig, index); + Tcl_WStrcpy(newstr+index, orig+index+count); + + /* + * Check if there's already a mapping for this string. + */ + length = Tcl_KanjiDecode(kanjiCode, newstr, NULL); + str = (char *) ckalloc((unsigned)(length + 1)); + (void) Tcl_KanjiDecode(kanjiCode, newstr, str); + + wstrHashPtr = Tcl_CreateHashEntry(&wstrTable, str, &new); + if (!new) { + wstrPtr = (TkWStr *) Tcl_GetHashValue(wstrHashPtr); + wstrPtr->refCount++; + ckfree((char *) newstr); + ckfree(str); + Tk_FreeWStr(orig); + return wstrPtr->wstr; + } + + /* + * The string isn't currently known. Map from the string to + * a wide string, and add a new structure to the database. + */ + wstrPtr = (TkWStr *) ckalloc(sizeof(TkWStr)); + wstrPtr->kanjiCode = kanjiCode; + wstrPtr->str = str; + wstrPtr->wstr = newstr; + wstrPtr->refCount = 1; + wstrPtr->wstrHashPtr = wstrHashPtr; + idHashPtr = Tcl_CreateHashEntry(&ws_idTable, (char *)wstrPtr->wstr, &new); + if (!new) { + panic("wstr already registered in Tk_DeleteWStr"); + } + Tcl_SetHashValue(wstrPtr->wstrHashPtr, wstrPtr); + Tcl_SetHashValue(idHashPtr, wstrPtr); + + Tk_FreeWStr(orig); + return wstrPtr->wstr; + } + + /* + *-------------------------------------------------------------- + * + * Tk_DecodeWStr -- + * + * Answer the original string of the wide string. + * + * Results: + * The return value is the original string of the wide string. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + + char * + Tk_DecodeWStr(wstr) + wchar *wstr; + { + Tcl_HashEntry *idHashPtr; + register TkWStr *wstrPtr; + + if (!ws_initialized) panic("Tk_DecodeWStr called before Tk_GetWStr"); + + idHashPtr = Tcl_FindHashEntry(&ws_idTable, (char *)wstr); + if( idHashPtr == NULL ) { + panic("Tk_DecodeWStr received unknown wstr argument"); + } + wstrPtr = (TkWStr *) Tcl_GetHashValue(idHashPtr); + + return wstrPtr->str; + } + + /* + *---------------------------------------------------------------------- + * + * WStrInit -- + * + * Initialize the structures used for WStr management. + * + * Results: + * None. + * + * Side effects: + * Read the code. + * + *---------------------------------------------------------------------- + */ + + static void + WStrInit() + { + ws_initialized = 1; + Tcl_InitHashTable(&wstrTable, TCL_STRING_KEYS); + Tcl_InitHashTable(&ws_idTable, TCL_ONE_WORD_KEYS); + } + + /* + *-------------------------------------------------------------- + * + * TkWSDrawString -- + * + * Draw a wide string on the screen. + * + * Results: + * None. + * + * Side effects: + * Information gets drawn on the screen. + * + *-------------------------------------------------------------- + */ + + int + TkWSDrawString(display, drawable, gcset, x, y, wstring, length) + Display *display; + Drawable drawable; + XWSGC gcset; + int x, y; + wchar *wstring; + int length; + { + return wsdrawstring(display, drawable, gcset, x, y, wstring, length); + } + + /* + *-------------------------------------------------------------- + * + * TkWSTextWidth -- + * + * Get the width in pixels of the wide string. + * + * Results: + * None. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + + int + TkWSTextWidth(gcset, wstr, len) + XWSGC gcset; + wchar *wstr; + int len; + { + #define bufsize 256 + XChar2b buf[bufsize]; + XChar2b *cp; + XChar2b *cpend = buf + bufsize; + wchar *wstr1 = wstr + len; + int c; + int width = 0; + int gmask, gset; + FontEnt *fe; + int gr_mapping; + + while( wstr < wstr1 ) { + gmask = *wstr & 0x8080; + gr_mapping = 0; + + switch( gmask ) { + case G0MASK: + gset = 0; + break; + case G1MASK: + gset = 1; + break; + #ifdef ORIGINAL_XWSTR + case G2MASK: + gset = 2; + break; + case G3MASK: + gset = 3; + break; + #else /* to display every one byte character */ + case G2MASK: + case G3MASK: + gset = 0; + gr_mapping = 1; + break; + #endif /* ORIGINAL_XWSTR */ + } + + fe = &gcset->fe[gset]; + gr_mapping |= fe->flag & TK_GRMAPPING; + cp = buf; + + if( fe->font == NULL ) { + while( wstr < wstr1 && (*wstr & 0x8080) == gmask ) wstr++; + continue; + } + + while( wstr < wstr1 && ((c = *wstr) & 0x8080) == gmask ) { + if( cp >= cpend - 1) { + /* flush */ + width += XTextWidth16(fe->font, buf, cp - buf); + cp = buf; + } + cp->byte1 = (c >> 8) & 0x7f; + cp->byte2 = c & 0x7f; + if (gr_mapping) { + if (cp->byte1 != 0) cp->byte1 |= 0x80; + cp->byte2 |= 0x80; + } + cp++; + wstr++; + } + + if( cp == buf ) continue; + + /* flush */ + width += XTextWidth16(fe->font, buf, cp - buf); + } + + return width; + } + + /* + *-------------------------------------------------------------- + * + * TkWSTextExtents -- + * + * Get string and font metrics of the wide string. + * + * Results: + * None. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + + void + TkWSTextExtents(gcset, wstr, len, ascent, descent, overall) + XWSGC gcset; + wchar *wstr; + int len; + int *ascent, *descent; + XCharStruct *overall; + { + #define bufsize 256 + #define INITIAL_LBEARING 9999 + XChar2b buf[bufsize]; + XChar2b *cp; + XChar2b *cpend = buf + bufsize; + wchar *wstr1 = wstr + len; + int c; + int gmask, gset; + FontEnt *fe; + int gr_mapping; + int dir, as, ds; + XCharStruct oa; + + *ascent = *descent = 0; + memset((VOID *) overall, 0, sizeof(XCharStruct)); + overall->lbearing = INITIAL_LBEARING; + + while( wstr < wstr1 ) { + gmask = *wstr & 0x8080; + gr_mapping = 0; + + switch( gmask ) { + case G0MASK: + gset = 0; + break; + case G1MASK: + gset = 1; + break; + #ifdef ORIGINAL_XWSTR + case G2MASK: + gset = 2; + break; + case G3MASK: + gset = 3; + break; + #else /* to display every one byte character */ + case G2MASK: + case G3MASK: + gset = 0; + gr_mapping = 1; + break; + #endif /* ORIGINAL_XWSTR */ + } + + fe = &gcset->fe[gset]; + gr_mapping |= fe->flag & TK_GRMAPPING; + cp = buf; + + if( fe->font == NULL ) { + while( wstr < wstr1 && (*wstr & 0x8080) == gmask ) wstr++; + continue; + } + + while( wstr < wstr1 && ((c = *wstr) & 0x8080) == gmask ) { + if( cp >= cpend - 1 ) { + /* flush */ + XTextExtents16(fe->font, buf, cp - buf, + &dir, &as, &ds, &oa); + cp = buf; + *ascent = MAX(*ascent, as); + *descent = MAX(*descent, ds); + overall->lbearing = MIN(overall->lbearing, + overall->width + oa.lbearing); + overall->rbearing = MAX(overall->rbearing, + overall->width + oa.rbearing); + overall->width += oa.width; + overall->ascent = MAX(overall->ascent, oa.ascent); + overall->descent = MAX(overall->descent, oa.descent); + } + cp->byte1 = (c >> 8) & 0x7f; + cp->byte2 = c & 0x7f; + if (gr_mapping) { + if (cp->byte1 != 0) cp->byte1 |= 0x80; + cp->byte2 |= 0x80; + } + cp++; + wstr++; + } + + if( cp == buf ) continue; + + /* flush */ + XTextExtents16(fe->font, buf, cp - buf, &dir, &as, &ds, &oa); + + *ascent = MAX(*ascent, as); + *descent = MAX(*descent, ds); + overall->lbearing = MIN(overall->lbearing, + overall->width + oa.lbearing); + overall->rbearing = MAX(overall->rbearing, + overall->width + oa.rbearing); + overall->width += oa.width; + overall->ascent = MAX(overall->ascent, oa.ascent); + overall->descent = MAX(overall->descent, oa.descent); + } + if( overall->lbearing == INITIAL_LBEARING ) { + overall->lbearing = 0; + } + #undef INITIAL_LBEARING + } + + static int + wsdrawstring(display, drawable, gcset, x, y, wstr, len) + Display *display; + Drawable drawable; + XWSGC gcset; + int x, y; + wchar *wstr; + int len; + { + #define bufsize 256 + XChar2b buf[bufsize]; + XChar2b *cp; + XChar2b *cpend = buf + bufsize; + wchar *wstr1 = wstr + len; + int c; + int sx = x; + int gmask, gset; + FontEnt *fe; + int gr_mapping; + + while( wstr < wstr1 ) { + gmask = *wstr & 0x8080; + gr_mapping = 0; + + switch( gmask ) { + case G0MASK: + gset = 0; + break; + case G1MASK: + gset = 1; + break; + #ifdef ORIGINAL_XWSTR + case G2MASK: + gset = 2; + break; + case G3MASK: + gset = 3; + break; + #else /* to display every one byte character */ + case G2MASK: + case G3MASK: + gset = 0; + gr_mapping = 1; + break; + #endif /* ORIGINAL_XWSTR */ + } + + fe = &gcset->fe[gset]; + gr_mapping |= fe->flag & TK_GRMAPPING; + cp = buf; + + if( fe->font == NULL ) { + while( wstr < wstr1 && (*wstr & 0x8080) == gmask ) wstr++; + continue; + } + while( wstr < wstr1 && ((c = *wstr) & 0x8080) == gmask ) { + if( cp >= cpend - 1 ) { + /* flush */ + x += flushstr(display, drawable, fe, x, y, buf, cp); + cp = buf; + } + cp->byte1 = (c >> 8) & 0x7f; + cp->byte2 = c & 0x7f; + if (gr_mapping) { + if (cp->byte1 != 0) cp->byte1 |= 0x80; + cp->byte2 |= 0x80; + } + cp++; + wstr++; + } + /* flush */ + x += flushstr(display, drawable, fe, x, y, buf, cp); + cp = buf; + } + + return x - sx; + } + + static int + flushstr(display, drawable, fe, x, y, cp0, cp1) + Display *display; + Drawable drawable; + FontEnt *fe; + int x, y; + XChar2b *cp0, *cp1; + { + if( cp0 >= cp1 || fe->gc == NULL ) return 0; + + XDrawString16(display, drawable, fe->gc, x, y, cp0, cp1 - cp0); + return XTextWidth16(fe->font, cp0, cp1 - cp0); + } + + #endif /* KANJI */ diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/generic/tkWStr.h ./generic/tkWStr.h *** ../tk4.2/generic/tkWStr.h Thu Jan 1 09:00:00 1970 --- ./generic/tkWStr.h Fri Oct 18 13:14:59 1996 *************** *** 0 **** --- 1,73 ---- + /* + * tkWStr.h -- + * + * Declarations for the wide strings. + * + * Copyright 1988,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/tk/generic/tkWStr.h,v 1.1 1995/12/21 08:31:46 hoshi Exp $ + */ + + #ifndef _TKWSTR + #define _TKWSTR + + #ifdef KANJI + + #ifndef _TK + #include "tk.h" + #endif + + /* + * + */ + + typedef struct { + XFontStruct *asciiFont; + XFontStruct *kanjiFont; + XCharStruct min_bounds; + XCharStruct max_bounds; + int ascent; + int descent; + } XWSFontSet; + + typedef struct { + GC gc; + XFontStruct *font; + int flag; + } FontEnt; + + typedef struct { + FontEnt fe[4]; + } XWSGCSet; + + typedef XWSGCSet *XWSGC; + + /* + * + */ + #define TK_TWOB 1 /* 2-byte character set */ + #define TK_FONTQUERY 2 /* XQueryFont()'ed by this library */ + #define TK_GCCREAT 4 /* XtGetGC()'ed by this library */ + #define TK_GRMAPPING 8 /* the character codes are mapped to GR + * (i.e. their MSBs are 1) */ + + #define G0MASK 0x0000 + #define G1MASK 0x8080 + #define G2MASK 0x0080 + #define G3MASK 0x8000 + + #define IS2B(f) (((f)->max_byte1 > 0) || ((f)->max_char_or_byte2 > 255)) + + #endif /* KANJI */ + + #endif /* _TKWSTR */ diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/generic/tkWindow.c ./generic/tkWindow.c *** ../tk4.2/generic/tkWindow.c Sun Oct 13 09:14:56 1996 --- ./generic/tkWindow.c Fri Oct 18 13:15:00 1996 *************** *** 125,130 **** --- 125,133 ---- {"update", Tk_UpdateCmd}, {"winfo", Tk_WinfoCmd}, {"wm", Tk_WmCmd}, + #ifdef KANJI + {"kanjiInput", Tk_KanjiInputCmd}, + #endif /* KANJI */ /* * Widget class commands. diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/README ./library/demos.jp/README *** ../tk4.2/library/demos.jp/README Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/README Sun Nov 24 18:25:54 1996 *************** *** 0 **** --- 1,7 ---- + This directory contains a collection of demonstration programs that + are translated into Japanese. You need to use a Japanized "wish" to + see these Japanese-translated demonstration programs. You also need + to put this directory ("demos.jp") at the next to "demos" since some + of the programs refer to the image files at "demos". + + Please refer to the README file at "demos" for more detail. diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/README.JP ./library/demos.jp/README.JP *** ../tk4.2/library/demos.jp/README.JP Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/README.JP Sun Nov 24 18:25:54 1996 *************** *** 0 **** --- 1,14 ---- + This directory contains "widget" demo for the Japanized Tcl7.6/Tk4.2. + Most of the messages in the original are translated to Japanese. + But other tools in this directory are not translated. + + Following 2 kanji fonts are defined at the beginning of the file "widget." + + -*--24-*-jisx0208.1983-0 + -*--16-*-jisx0208.1983-0 + + These fonts are all part of the core distribution of X11R5, so + if you are running X11R5, you don't have to modify the file. + + But if you don't have these fonts, replace them with appropriate ones. + "-*--14-*-jisx0208.1983-0" will be a good choice. diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/arrow.tcl ./library/demos.jp/arrow.tcl *** ../tk4.2/library/demos.jp/arrow.tcl Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/arrow.tcl Sun Nov 24 18:25:54 1996 *************** *** 0 **** --- 1,234 ---- + # arrow.tcl -- + # + # This demonstration script creates a canvas widget that displays a + # large line with an arrowhead whose shape can be edited interactively. + # + # SCCS: @(#) arrow.tcl 1.6 96/04/12 12:08:30 + + # arrowSetup -- + # This procedure regenerates all the text and graphics in the canvas + # window. It's called when the canvas is initially created, and also + # whenever any of the parameters of the arrow head are changed + # interactively. + # + # Arguments: + # c - Name of the canvas widget. + + proc arrowSetup c { + upvar #0 demo_arrowInfo v + + # Remember the current box, if there is one. + + set tags [$c gettags current] + if {$tags != ""} { + set cur [lindex $tags [lsearch -glob $tags box?]] + } else { + set cur "" + } + + # Create the arrow and outline. + + $c delete all + eval "$c create line $v(x1) $v(y) $v(x2) $v(y) -width [expr 10*$v(width)] \ + -arrowshape {[expr 10*$v(a)] [expr 10*$v(b)] [expr 10*$v(c)]} \ + -arrow last $v(bigLineStyle)" + set xtip [expr $v(x2)-10*$v(b)] + set deltaY [expr 10*$v(c)+5*$v(width)] + $c create line $v(x2) $v(y) $xtip [expr $v(y)+$deltaY] \ + [expr $v(x2)-10*$v(a)] $v(y) $xtip [expr $v(y)-$deltaY] \ + $v(x2) $v(y) -width 2 -capstyle round -joinstyle round + + # Create the boxes for reshaping the line and arrowhead. + + eval "$c create rect [expr $v(x2)-10*$v(a)-5] [expr $v(y)-5] \ + [expr $v(x2)-10*$v(a)+5] [expr $v(y)+5] $v(boxStyle) \ + -tags {box1 box}" + eval "$c create rect [expr $xtip-5] [expr $v(y)-$deltaY-5] \ + [expr $xtip+5] [expr $v(y)-$deltaY+5] $v(boxStyle) \ + -tags {box2 box}" + eval "$c create rect [expr $v(x1)-5] [expr $v(y)-5*$v(width)-5] \ + [expr $v(x1)+5] [expr $v(y)-5*$v(width)+5] $v(boxStyle) \ + -tags {box3 box}" + if {$cur != ""} { + eval $c itemconfigure $cur $v(activeStyle) + } + + # Create three arrows in actual size with the same parameters + + $c create line [expr $v(x2)+50] 0 [expr $v(x2)+50] 1000 \ + -width 2 + set tmp [expr $v(x2)+100] + $c create line $tmp [expr $v(y)-125] $tmp [expr $v(y)-75] \ + -width $v(width) \ + -arrow both -arrowshape "$v(a) $v(b) $v(c)" + $c create line [expr $tmp-25] $v(y) [expr $tmp+25] $v(y) \ + -width $v(width) \ + -arrow both -arrowshape "$v(a) $v(b) $v(c)" + $c create line [expr $tmp-25] [expr $v(y)+75] [expr $tmp+25] \ + [expr $v(y)+125] -width $v(width) \ + -arrow both -arrowshape "$v(a) $v(b) $v(c)" + + # Create a bunch of other arrows and text items showing the + # current dimensions. + + set tmp [expr $v(x2)+10] + $c create line $tmp [expr $v(y)-5*$v(width)] \ + $tmp [expr $v(y)-$deltaY] \ + -arrow both -arrowshape $v(smallTips) + $c create text [expr $v(x2)+15] [expr $v(y)-$deltaY+5*$v(c)] \ + -text $v(c) -anchor w + set tmp [expr $v(x1)-10] + $c create line $tmp [expr $v(y)-5*$v(width)] \ + $tmp [expr $v(y)+5*$v(width)] \ + -arrow both -arrowshape $v(smallTips) + $c create text [expr $v(x1)-15] $v(y) -text $v(width) -anchor e + set tmp [expr $v(y)+5*$v(width)+10*$v(c)+10] + $c create line [expr $v(x2)-10*$v(a)] $tmp $v(x2) $tmp \ + -arrow both -arrowshape $v(smallTips) + $c create text [expr $v(x2)-5*$v(a)] [expr $tmp+5] \ + -text $v(a) -anchor n + set tmp [expr $tmp+25] + $c create line [expr $v(x2)-10*$v(b)] $tmp $v(x2) $tmp \ + -arrow both -arrowshape $v(smallTips) + $c create text [expr $v(x2)-5*$v(b)] [expr $tmp+5] \ + -text $v(b) -anchor n + + $c create text $v(x1) 310 -text "-width $v(width)" \ + -anchor w -font -*-Helvetica-Medium-R-Normal--*-180-*-*-*-*-*-* + $c create text $v(x1) 330 -text "-arrowshape {$v(a) $v(b) $v(c)}" \ + -anchor w -font -*-Helvetica-Medium-R-Normal--*-180-*-*-*-*-*-* + + incr v(count) + } + + set w .arrow + global tk_library + catch {destroy $w} + toplevel $w + wm title $w "Arrowhead Editor Demonstration" + wm iconname $w "arrow" + positionWindow $w + set c $w.c + + label $w.msg -font $font -wraplength 5i -justify left -text "この widget で、キャンバスで使われるラインについて様々な幅や矢印の頭の形を試してみることができます。線の幅や矢印の形を変えるには、拡大された矢印についている 3つの四角をドラッグしてください。右側の矢印は普通の大きさでのサンプルを示しています。下のテキストはラインアイテムに対する設定オプションです。" + pack $w.msg -side top + + frame $w.buttons + pack $w.buttons -side bottom -fill x -pady 2m + button $w.buttons.dismiss -text 了解 -command "destroy $w" + button $w.buttons.code -text コード参照 -command "showCode $w" + pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 + + canvas $c -width 500 -height 350 -relief sunken -borderwidth 2 + pack $c -expand yes -fill both + + set demo_arrowInfo(a) 8 + set demo_arrowInfo(b) 10 + set demo_arrowInfo(c) 3 + set demo_arrowInfo(width) 2 + set demo_arrowInfo(motionProc) arrowMoveNull + set demo_arrowInfo(x1) 40 + set demo_arrowInfo(x2) 350 + set demo_arrowInfo(y) 150 + set demo_arrowInfo(smallTips) {5 5 2} + set demo_arrowInfo(count) 0 + if {[winfo depth $c] > 1} { + set demo_arrowInfo(bigLineStyle) "-fill SkyBlue1" + set demo_arrowInfo(boxStyle) "-fill {} -outline black -width 1" + set demo_arrowInfo(activeStyle) "-fill red -outline black -width 1" + } else { + set demo_arrowInfo(bigLineStyle) "-fill black \ + -stipple @[file join $tk_library demos images grey.25]" + set demo_arrowInfo(boxStyle) "-fill {} -outline black -width 1" + set demo_arrowInfo(activeStyle) "-fill black -outline black -width 1" + } + arrowSetup $c + $c bind box "$c itemconfigure current $demo_arrowInfo(activeStyle)" + $c bind box "$c itemconfigure current $demo_arrowInfo(boxStyle)" + $c bind box " " + $c bind box " " + $c bind box1 <1> {set demo_arrowInfo(motionProc) arrowMove1} + $c bind box2 <1> {set demo_arrowInfo(motionProc) arrowMove2} + $c bind box3 <1> {set demo_arrowInfo(motionProc) arrowMove3} + $c bind box "\$demo_arrowInfo(motionProc) $c %x %y" + bind $c "arrowSetup $c" + + # arrowMove1 -- + # This procedure is called for each mouse motion event on box1 (the + # one at the vertex of the arrow). It updates the controlling parameters + # for the line and arrowhead. + # + # Arguments: + # c - The name of the canvas window. + # x, y - The coordinates of the mouse. + + proc arrowMove1 {c x y} { + upvar #0 demo_arrowInfo v + set newA [expr ($v(x2)+5-round([$c canvasx $x]))/10] + if {$newA < 0} { + set newA 0 + } + if {$newA > 25} { + set newA 25 + } + if {$newA != $v(a)} { + $c move box1 [expr 10*($v(a)-$newA)] 0 + set v(a) $newA + } + } + + # arrowMove2 -- + # This procedure is called for each mouse motion event on box2 (the + # one at the trailing tip of the arrowhead). It updates the controlling + # parameters for the line and arrowhead. + # + # Arguments: + # c - The name of the canvas window. + # x, y - The coordinates of the mouse. + + proc arrowMove2 {c x y} { + upvar #0 demo_arrowInfo v + set newB [expr ($v(x2)+5-round([$c canvasx $x]))/10] + if {$newB < 0} { + set newB 0 + } + if {$newB > 25} { + set newB 25 + } + set newC [expr ($v(y)+5-round([$c canvasy $y])-5*$v(width))/10] + if {$newC < 0} { + set newC 0 + } + if {$newC > 20} { + set newC 20 + } + if {($newB != $v(b)) || ($newC != $v(c))} { + $c move box2 [expr 10*($v(b)-$newB)] [expr 10*($v(c)-$newC)] + set v(b) $newB + set v(c) $newC + } + } + + # arrowMove3 -- + # This procedure is called for each mouse motion event on box3 (the + # one that controls the thickness of the line). It updates the + # controlling parameters for the line and arrowhead. + # + # Arguments: + # c - The name of the canvas window. + # x, y - The coordinates of the mouse. + + proc arrowMove3 {c x y} { + upvar #0 demo_arrowInfo v + set newWidth [expr ($v(y)+2-round([$c canvasy $y]))/5] + if {$newWidth < 0} { + set newWidth 0 + } + if {$newWidth > 20} { + set newWidth 20 + } + if {$newWidth != $v(width)} { + $c move box3 0 [expr 5*($v(width)-$newWidth)] + set v(width) $newWidth + } + } diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/bind.tcl ./library/demos.jp/bind.tcl *** ../tk4.2/library/demos.jp/bind.tcl Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/bind.tcl Sun Nov 24 18:25:54 1996 *************** *** 0 **** --- 1,75 ---- + # bind.tcl -- + # + # This demonstration script creates a text widget with bindings set + # up for hypertext-like effects. + # + # SCCS: @(#) bind.tcl 1.5 96/04/12 11:48:26 + + set w .bind + catch {destroy $w} + toplevel $w + wm title $w "Text Demonstration - Tag Bindings" + wm iconname $w "bind" + positionWindow $w + + frame $w.buttons + pack $w.buttons -side bottom -fill x -pady 2m + button $w.buttons.dismiss -text 了解 -command "destroy $w" + button $w.buttons.code -text コード参照 -command "showCode $w" + pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 + + text $w.text -yscrollcommand "$w.scroll set" -setgrid true \ + -width 60 -height 24 -font $font -wrap word + scrollbar $w.scroll -command "$w.text yview" + pack $w.scroll -side right -fill y + pack $w.text -expand yes -fill both + + # Set up display styles. + + if {[winfo depth $w] > 1} { + set bold "-background #43ce80 -relief raised -borderwidth 1" + set normal "-background {} -relief flat" + } else { + set bold "-foreground white -background black" + set normal "-foreground {} -background {}" + } + + # Add text to widget. + + $w.text insert 0.0 {\ + テキストwidgetの表示スタイルを制御するのと同じタグのメカニズムを使って、テキストにTclのコマンドを割り当てることができます。これにより、マウスやキーボードのアクションで特定のTclのコマンドが実行されるようになります。例えば、下のキャンバスのデモプログラムについての説明文にはそのようなタグがついています。マウスを説明文の上に持っていくと説明文が光り、ボタン1を押すとその説明のデモが始まります。 + + } + $w.text insert end \ + {1. キャンバス widget に作ることのできるアイテムの種類全てに関するサンプル。} d1 + $w.text insert end \n\n + $w.text insert end \ + {2. 簡単な 2次元のプロット。データを表す点を動かすことができる。} d2 + $w.text insert end \n\n + $w.text insert end \ + {3. テキストアイテムのアンカーと行揃え。} d3 + $w.text insert end \n\n + $w.text insert end \ + {4. ラインアイテムのための矢印の頭の形のエディタ。} d4 + $w.text insert end \n\n + $w.text insert end \ + {5. タブストップを変更するための機能つきのルーラー。} d5 + $w.text insert end \n\n + $w.text insert end \ + {6. キャンバスがどうやってスクロールするのかを示すグリッド。} d6 + + # Create bindings for tags. + + foreach tag {d1 d2 d3 d4 d5 d6} { + $w.text tag bind $tag "$w.text tag configure $tag $bold" + $w.text tag bind $tag "$w.text tag configure $tag $normal" + } + $w.text tag bind d1 <1> {source [file join $tk_library demos.jp items.tcl]} + $w.text tag bind d2 <1> {source [file join $tk_library demos.jp plot.tcl]} + $w.text tag bind d3 <1> {source [file join $tk_library demos.jp ctext.tcl]} + $w.text tag bind d4 <1> {source [file join $tk_library demos.jp arrow.tcl]} + $w.text tag bind d5 <1> {source [file join $tk_library demos.jp ruler.tcl]} + $w.text tag bind d6 <1> {source [file join $tk_library demos.jp cscroll.tcl]} + + $w.text mark set insert 0.0 + $w.text configure -state disabled diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/bitmap.tcl ./library/demos.jp/bitmap.tcl *** ../tk4.2/library/demos.jp/bitmap.tcl Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/bitmap.tcl Sun Nov 24 18:25:54 1996 *************** *** 0 **** --- 1,51 ---- + # bitmap.tcl -- + # + # This demonstration script creates a toplevel window that displays + # all of Tk's built-in bitmaps. + # + # SCCS: @(#) bitmap.tcl 1.4 96/02/16 10:49:27 + + # bitmapRow -- + # Create a row of bitmap items in a window. + # + # Arguments: + # w - The window that is to contain the row. + # args - The names of one or more bitmaps, which will be displayed + # in a new row across the bottom of w along with their + # names. + + proc bitmapRow {w args} { + frame $w + pack $w -side top -fill both + set i 0 + foreach bitmap $args { + frame $w.$i + pack $w.$i -side left -fill both -pady .25c -padx .25c + label $w.$i.bitmap -bitmap $bitmap + label $w.$i.label -text $bitmap -width 9 + pack $w.$i.label $w.$i.bitmap -side bottom + incr i + } + } + + set w .bitmap + global tk_library + catch {destroy $w} + toplevel $w + wm title $w "Bitmap Demonstration" + wm iconname $w "bitmap" + positionWindow $w + + label $w.msg -font $font -wraplength 4i -justify left -text "このウィンドウには、Tk に組み込まれたすべてのビットマップが、それらの名前と共に表示されています。Tcl のスクリプト中では、それぞれの名前を用いて参照します。" + pack $w.msg -side top + + frame $w.buttons + pack $w.buttons -side bottom -fill x -pady 2m + button $w.buttons.dismiss -text 了解 -command "destroy $w" + button $w.buttons.code -text コード参照 -command "showCode $w" + pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 + + frame $w.frame + bitmapRow $w.frame.0 error gray12 gray50 hourglass + bitmapRow $w.frame.1 info question questhead warning + pack $w.frame -side top -expand yes -fill both diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/browse ./library/demos.jp/browse *** ../tk4.2/library/demos.jp/browse Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/browse Sun Nov 24 18:25:54 1996 *************** *** 0 **** --- 1,56 ---- + #!/bin/sh + # the next line restarts using wish \ + exec wish "$0" "$@" + + # browse -- + # This script generates a directory browser, which lists the working + # directory and allows you to open files or subdirectories by + # double-clicking. + # + # SCCS: @(#) browse 1.8 96/02/16 10:49:18 + + # Create a scrollbar on the right side of the main window and a listbox + # on the left side. + + scrollbar .scroll -command ".list yview" + pack .scroll -side right -fill y + listbox .list -yscroll ".scroll set" -relief sunken -width 20 -height 20 \ + -setgrid yes + pack .list -side left -fill both -expand yes + wm minsize . 1 1 + + # The procedure below is invoked to open a browser on a given file; if the + # file is a directory then another instance of this program is invoked; if + # the file is a regular file then the Mx editor is invoked to display + # the file. + + proc browse {dir file} { + global env + if {[string compare $dir "."] != 0} {set file $dir/$file} + if [file isdirectory $file] { + exec browse $file & + } else { + if [file isfile $file] { + if [info exists env(EDITOR)] { + eval exec $env(EDITOR) $file & + } else { + exec xedit $file & + } + } else { + puts stdout "\"$file\" isn't a directory or regular file" + } + } + } + + # Fill the listbox with a list of all the files in the directory (run + # the "ls" command to get that information). + + if $argc>0 {set dir [lindex $argv 0]} else {set dir "."} + foreach i [exec ls -a $dir] { + .list insert end $i + } + + # Set up bindings for the browser. + + bind all {destroy .} + bind .list {foreach i [selection get] {browse $dir $i}} diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/button.tcl ./library/demos.jp/button.tcl *** ../tk4.2/library/demos.jp/button.tcl Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/button.tcl Sun Nov 24 18:25:54 1996 *************** *** 0 **** --- 1,32 ---- + # button.tcl -- + # + # This demonstration script creates a toplevel window containing + # several button widgets. + # + # SCCS: @(#) button.tcl 1.4 96/08/20 15:50:22 + + set w .button + catch {destroy $w} + toplevel $w + wm title $w "Button Demonstration" + wm iconname $w "button" + positionWindow $w + + label $w.msg -font $font -wraplength 4i -justify left -text "ボタンをクリックすると、ボタンの背景色がそのボタンに書かれている色になります。ボタンからボタンへの移動はタブを押すことでも可能です。またスペースで実行することができます。" + pack $w.msg -side top + + frame $w.buttons + pack $w.buttons -side bottom -fill x -pady 2m + button $w.buttons.dismiss -text 了解 -command "destroy $w" + button $w.buttons.code -text コード参照 -command "showCode $w" + pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 + + button $w.b1 -text "Peach Puff" -width 10 \ + -command "$w config -bg PeachPuff1; $w.buttons config -bg PeachPuff1" + button $w.b2 -text "Light Blue" -width 10 \ + -command "$w config -bg LightBlue1; $w.buttons config -bg LightBlue1" + button $w.b3 -text "Sea Green" -width 10 \ + -command "$w config -bg SeaGreen2; $w.buttons config -bg SeaGreen2" + button $w.b4 -text "Yellow" -width 10 \ + -command "$w config -bg Yellow1; $w.buttons config -bg Yellow1" + pack $w.b1 $w.b2 $w.b3 $w.b4 -side top -expand yes -pady 2 diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/check.tcl ./library/demos.jp/check.tcl *** ../tk4.2/library/demos.jp/check.tcl Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/check.tcl Sun Nov 24 18:25:54 1996 *************** *** 0 **** --- 1,29 ---- + # check.tcl -- + # + # This demonstration script creates a toplevel window containing + # several checkbuttons. + # + # SCCS: @(#) check.tcl 1.3 96/02/16 10:49:37 + + set w .check + catch {destroy $w} + toplevel $w + wm title $w "Checkbutton Demonstration" + wm iconname $w "check" + positionWindow $w + + label $w.msg -font $font -wraplength 4i -justify left -text "下には 3 つのチェックボタンが表示されています。クリックするとボタンの選択状態が変わり、Tcl 変数にそのボタンの状態を示す値を設定します。現在の変数の値を見るには「変数参照」ボタンをクリックしてください。" + pack $w.msg -side top + + frame $w.buttons + pack $w.buttons -side bottom -fill x -pady 2m + button $w.buttons.dismiss -text 了解 -command "destroy $w" + button $w.buttons.code -text コード参照 -command "showCode $w" + button $w.buttons.vars -text 変数参照 \ + -command "showVars $w.dialog wipers brakes sober" + pack $w.buttons.dismiss $w.buttons.code $w.buttons.vars -side left -expand 1 + + checkbutton $w.b1 -text "ワイパー OK" -variable wipers -relief flat + checkbutton $w.b2 -text "ブレーキ OK" -variable brakes -relief flat + checkbutton $w.b3 -text "ドライバー素面" -variable sober -relief flat + pack $w.b1 $w.b2 $w.b3 -side top -pady 2 -anchor w diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/clrpick.tcl ./library/demos.jp/clrpick.tcl *** ../tk4.2/library/demos.jp/clrpick.tcl Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/clrpick.tcl Sun Nov 24 18:33:16 1996 *************** *** 0 **** --- 1,52 ---- + # clrpick.tcl -- + # + # This demonstration script prompts the user to select a color. + # + # SCCS: @(#) clrpick.tcl 1.1 96/08/23 11:36:42 + + set w .clrpick + catch {destroy $w} + toplevel $w + wm title $w "File Selection Dialogs" + wm iconname $w "colors" + positionWindow $w + + label $w.msg -font $font -wraplength 4i -justify left -text "{^AEBhEEBWFbgOiFwiFIB" + pack $w.msg -side top + + frame $w.buttons + pack $w.buttons -side bottom -fill x -pady 2m + button $w.buttons.dismiss -text -command "destroy $w" + button $w.buttons.code -text R[hQ -command "showCode $w" + pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 + + button $w.back -text "wiF ..." \ + -command \ + "setColor $w $w.back background {-background -highlightbackground}" + button $w.fore -text "OiF ..." \ + -command \ + "setColor $w $w.back foreground -foreground" + + pack $w.back $w.fore -side top -anchor c -pady 2m + + proc setColor {w button name options} { + grab $w + set initialColor [$button cget -$name] + set color [tk_chooseColor -title "Choose a $name color" -parent $w \ + -initialcolor $initialColor] + if [string compare $color ""] { + setColor_helper $w $options $color + } + grab release $w + } + + proc setColor_helper {w options color} { + foreach option $options { + catch { + $w config $option $color + } + } + foreach child [winfo children $w] { + setColor_helper $child $options $color + } + } diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/colors.tcl ./library/demos.jp/colors.tcl *** ../tk4.2/library/demos.jp/colors.tcl Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/colors.tcl Sun Nov 24 18:25:54 1996 *************** *** 0 **** --- 1,97 ---- + # colors.tcl -- + # + # This demonstration script creates a listbox widget that displays + # many of the colors from the X color database. You can click on + # a color to change the application's palette. + # + # SCCS: @(#) colors.tcl 1.3 96/02/16 10:49:41 + + set w .colors + catch {destroy $w} + toplevel $w + wm title $w "Listbox Demonstration (colors)" + wm iconname $w "Listbox" + positionWindow $w + + label $w.msg -font $font -wraplength 4i -justify left -text "下には色の名前が入ったスクロールバー付のリストボックスが表示されています。リストをスクロールさせるのはスクロールバーでもできますし、リストボックスの中でマウスのボタン2 (中ボタン) を押したままドラッグしてもできます。ある色をボタン1 (左ボタン) でダブルクリックするとアプリケーション全体がその色になります。" + pack $w.msg -side top + + frame $w.buttons + pack $w.buttons -side bottom -fill x -pady 2m + button $w.buttons.dismiss -text 了解 -command "destroy $w" + button $w.buttons.code -text コード参照 -command "showCode $w" + pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 + + frame $w.frame -borderwidth 10 + pack $w.frame -side top -expand yes -fill y + + scrollbar $w.frame.scroll -command "$w.frame.list yview" + listbox $w.frame.list -yscroll "$w.frame.scroll set" \ + -width 20 -height 16 -setgrid 1 + pack $w.frame.list $w.frame.scroll -side left -fill y -expand 1 + + bind $w.frame.list { + tk_setPalette [selection get] + } + $w.frame.list insert 0 gray60 gray70 gray80 gray85 gray90 gray95 \ + snow1 snow2 snow3 snow4 seashell1 seashell2 \ + seashell3 seashell4 AntiqueWhite1 AntiqueWhite2 AntiqueWhite3 \ + AntiqueWhite4 bisque1 bisque2 bisque3 bisque4 PeachPuff1 \ + PeachPuff2 PeachPuff3 PeachPuff4 NavajoWhite1 NavajoWhite2 \ + NavajoWhite3 NavajoWhite4 LemonChiffon1 LemonChiffon2 \ + LemonChiffon3 LemonChiffon4 cornsilk1 cornsilk2 cornsilk3 \ + cornsilk4 ivory1 ivory2 ivory3 ivory4 honeydew1 honeydew2 \ + honeydew3 honeydew4 LavenderBlush1 LavenderBlush2 \ + LavenderBlush3 LavenderBlush4 MistyRose1 MistyRose2 \ + MistyRose3 MistyRose4 azure1 azure2 azure3 azure4 \ + SlateBlue1 SlateBlue2 SlateBlue3 SlateBlue4 RoyalBlue1 \ + RoyalBlue2 RoyalBlue3 RoyalBlue4 blue1 blue2 blue3 blue4 \ + DodgerBlue1 DodgerBlue2 DodgerBlue3 DodgerBlue4 SteelBlue1 \ + SteelBlue2 SteelBlue3 SteelBlue4 DeepSkyBlue1 DeepSkyBlue2 \ + DeepSkyBlue3 DeepSkyBlue4 SkyBlue1 SkyBlue2 SkyBlue3 \ + SkyBlue4 LightSkyBlue1 LightSkyBlue2 LightSkyBlue3 \ + LightSkyBlue4 SlateGray1 SlateGray2 SlateGray3 SlateGray4 \ + LightSteelBlue1 LightSteelBlue2 LightSteelBlue3 \ + LightSteelBlue4 LightBlue1 LightBlue2 LightBlue3 \ + LightBlue4 LightCyan1 LightCyan2 LightCyan3 LightCyan4 \ + PaleTurquoise1 PaleTurquoise2 PaleTurquoise3 PaleTurquoise4 \ + CadetBlue1 CadetBlue2 CadetBlue3 CadetBlue4 turquoise1 \ + turquoise2 turquoise3 turquoise4 cyan1 cyan2 cyan3 cyan4 \ + DarkSlateGray1 DarkSlateGray2 DarkSlateGray3 \ + DarkSlateGray4 aquamarine1 aquamarine2 aquamarine3 \ + aquamarine4 DarkSeaGreen1 DarkSeaGreen2 DarkSeaGreen3 \ + DarkSeaGreen4 SeaGreen1 SeaGreen2 SeaGreen3 SeaGreen4 \ + PaleGreen1 PaleGreen2 PaleGreen3 PaleGreen4 SpringGreen1 \ + SpringGreen2 SpringGreen3 SpringGreen4 green1 green2 \ + green3 green4 chartreuse1 chartreuse2 chartreuse3 \ + chartreuse4 OliveDrab1 OliveDrab2 OliveDrab3 OliveDrab4 \ + DarkOliveGreen1 DarkOliveGreen2 DarkOliveGreen3 \ + DarkOliveGreen4 khaki1 khaki2 khaki3 khaki4 \ + LightGoldenrod1 LightGoldenrod2 LightGoldenrod3 \ + LightGoldenrod4 LightYellow1 LightYellow2 LightYellow3 \ + LightYellow4 yellow1 yellow2 yellow3 yellow4 gold1 gold2 \ + gold3 gold4 goldenrod1 goldenrod2 goldenrod3 goldenrod4 \ + DarkGoldenrod1 DarkGoldenrod2 DarkGoldenrod3 DarkGoldenrod4 \ + RosyBrown1 RosyBrown2 RosyBrown3 RosyBrown4 IndianRed1 \ + IndianRed2 IndianRed3 IndianRed4 sienna1 sienna2 sienna3 \ + sienna4 burlywood1 burlywood2 burlywood3 burlywood4 wheat1 \ + wheat2 wheat3 wheat4 tan1 tan2 tan3 tan4 chocolate1 \ + chocolate2 chocolate3 chocolate4 firebrick1 firebrick2 \ + firebrick3 firebrick4 brown1 brown2 brown3 brown4 salmon1 \ + salmon2 salmon3 salmon4 LightSalmon1 LightSalmon2 \ + LightSalmon3 LightSalmon4 orange1 orange2 orange3 orange4 \ + DarkOrange1 DarkOrange2 DarkOrange3 DarkOrange4 coral1 \ + coral2 coral3 coral4 tomato1 tomato2 tomato3 tomato4 \ + OrangeRed1 OrangeRed2 OrangeRed3 OrangeRed4 red1 red2 red3 \ + red4 DeepPink1 DeepPink2 DeepPink3 DeepPink4 HotPink1 \ + HotPink2 HotPink3 HotPink4 pink1 pink2 pink3 pink4 \ + LightPink1 LightPink2 LightPink3 LightPink4 PaleVioletRed1 \ + PaleVioletRed2 PaleVioletRed3 PaleVioletRed4 maroon1 \ + maroon2 maroon3 maroon4 VioletRed1 VioletRed2 VioletRed3 \ + VioletRed4 magenta1 magenta2 magenta3 magenta4 orchid1 \ + orchid2 orchid3 orchid4 plum1 plum2 plum3 plum4 \ + MediumOrchid1 MediumOrchid2 MediumOrchid3 MediumOrchid4 \ + DarkOrchid1 DarkOrchid2 DarkOrchid3 DarkOrchid4 purple1 \ + purple2 purple3 purple4 MediumPurple1 MediumPurple2 \ + MediumPurple3 MediumPurple4 thistle1 thistle2 thistle3 \ + thistle4 diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/cscroll.tcl ./library/demos.jp/cscroll.tcl *** ../tk4.2/library/demos.jp/cscroll.tcl Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/cscroll.tcl Sun Nov 24 18:25:54 1996 *************** *** 0 **** --- 1,92 ---- + # cscroll.tcl -- + # + # This demonstration script creates a simple canvas that can be + # scrolled in two dimensions. + # + # SCCS: @(#) cscroll.tcl 1.5 96/10/04 17:09:36 + + set w .cscroll + catch {destroy $w} + toplevel $w + wm title $w "Scrollable Canvas Demonstration" + wm iconname $w "cscroll" + positionWindow $w + set c $w.c + + label $w.msg -font $font -wraplength 4i -justify left -text "このウィンドウにはスクロールバーやマウスのボタン2 でスクロールできるキャンバス widget が表示されています。四角の上でボタン1 をクリックすると、そのインデックスが標準出力に出力されます。" + pack $w.msg -side top + + frame $w.buttons + pack $w.buttons -side bottom -fill x -pady 2m + button $w.buttons.dismiss -text 了解 -command "destroy $w" + button $w.buttons.code -text コード参照 -command "showCode $w" + pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 + + frame $w.grid + scrollbar $w.hscroll -orient horiz -command "$c xview" + scrollbar $w.vscroll -command "$c yview" + canvas $c -relief sunken -borderwidth 2 -scrollregion {-11c -11c 50c 20c} \ + -xscrollcommand "$w.hscroll set" \ + -yscrollcommand "$w.vscroll set" + pack $w.grid -expand yes -fill both -padx 1 -pady 1 + grid rowconfig $w.grid 0 -weight 1 -minsize 0 + grid columnconfig $w.grid 0 -weight 1 -minsize 0 + + grid $c -padx 1 -in $w.grid -pady 1 \ + -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news + grid $w.vscroll -in $w.grid -padx 1 -pady 1 \ + -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news + grid $w.hscroll -in $w.grid -padx 1 -pady 1 \ + -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news + + + set bg [lindex [$c config -bg] 4] + for {set i 0} {$i < 20} {incr i} { + set x [expr {-10 + 3*$i}] + for {set j 0; set y -10} {$j < 10} {incr j; incr y 3} { + $c create rect ${x}c ${y}c [expr $x+2]c [expr $y+2]c \ + -outline black -fill $bg -tags rect + $c create text [expr $x+1]c [expr $y+1]c -text "$i,$j" \ + -anchor center -tags text + } + } + + $c bind all "scrollEnter $c" + $c bind all "scrollLeave $c" + $c bind all <1> "scrollButton $c" + bind $c <2> "$c scan mark %x %y" + bind $c "$c scan dragto %x %y" + + proc scrollEnter canvas { + global oldFill + set id [$canvas find withtag current] + if {[lsearch [$canvas gettags current] text] >= 0} { + set id [expr $id-1] + } + set oldFill [lindex [$canvas itemconfig $id -fill] 4] + if {[winfo depth $canvas] > 1} { + $canvas itemconfigure $id -fill SeaGreen1 + } else { + $canvas itemconfigure $id -fill black + $canvas itemconfigure [expr $id+1] -fill white + } + } + + proc scrollLeave canvas { + global oldFill + set id [$canvas find withtag current] + if {[lsearch [$canvas gettags current] text] >= 0} { + set id [expr $id-1] + } + $canvas itemconfigure $id -fill $oldFill + $canvas itemconfigure [expr $id+1] -fill black + } + + proc scrollButton canvas { + global oldFill + set id [$canvas find withtag current] + if {[lsearch [$canvas gettags current] text] < 0} { + set id [expr $id+1] + } + puts stdout "You buttoned at [lindex [$canvas itemconf $id -text] 4]" + } diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/ctext.tcl ./library/demos.jp/ctext.tcl *** ../tk4.2/library/demos.jp/ctext.tcl Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/ctext.tcl Sun Nov 24 18:25:54 1996 *************** *** 0 **** --- 1,141 ---- + # ctext.tcl -- + # + # This demonstration script creates a canvas widget with a text + # item that can be edited and reconfigured in various ways. + # + # SCCS: @(#) ctext.tcl 1.4 96/02/16 10:49:16 + + set w .ctext + catch {destroy $w} + toplevel $w + wm title $w "Canvas Text Demonstration" + wm iconname $w "Text" + positionWindow $w + set c $w.c + + label $w.msg -font $font -wraplength 5i -justify left -text "このウィンドウにはキャンバス widget のテキスト機能をデモするためのテキスト文字列が表示されています。マウスを四角の中に持っていき、クリックすると位置ぎめ用の点からの相対位置を変えたり、行揃えを変えたりすることができます。また以下のような編集のための簡単なバインディングをサポートしています。 + + 1. マウスを持っていき、クリックし、入力できます。 + 2. ボタン 1 で選択できます。 + 3. マウスの位置にボタン2 で選択したテキストをコピーできます。 + 4.バックスペースをコントロール-H で挿入カーソルの直前の文字を削除します。 + 5. Delete キーは挿入カーソルの直後の文字を削除します。" + pack $w.msg -side top + + frame $w.buttons + pack $w.buttons -side bottom -fill x -pady 2m + button $w.buttons.dismiss -text 了解 -command "destroy $w" + button $w.buttons.code -text コード参照 -command "showCode $w" + pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 + + canvas $c -relief flat -borderwidth 0 -width 500 -height 350 + pack $w.c -side top -expand yes -fill both + + set textFont -*-Helvetica-Medium-R-Normal--*-240-*-*-*-*-*-* + + $c create rectangle 245 195 255 205 -outline black -fill red + + # First, create the text item and give it bindings so it can be edited. + + $c addtag text withtag [$c create text 250 200 -text "これはキャンバス widget のテキスト機能をデモするための文字列です。マウスを持っていき、クリックして入力できます。選択してコントロール-D で消去することもできます。" -width 440 -anchor n -font -*-Helvetica-Medium-R-Normal--*-240-*-*-*-*-*-* -kanjifont -*--24-*-jisx0208.1983-0 -justify left] + $c bind text <1> "textB1Press $c %x %y" + $c bind text "textB1Move $c %x %y" + $c bind text "$c select adjust current @%x,%y" + $c bind text "textB1Move $c %x %y" + $c bind text "textInsert $c %A" + $c bind text "textInsert $c \\n" + $c bind text "textBs $c" + $c bind text "textBs $c" + $c bind text "textDel $c" + $c bind text <2> "textPaste $c @%x,%y" + + # Next, create some items that allow the text's anchor position + # to be edited. + + proc mkTextConfig {w x y option value color} { + set item [$w create rect [expr $x] [expr $y] [expr $x+30] [expr $y+30] \ + -outline black -fill $color -width 1] + $w bind $item <1> "$w itemconf text $option $value" + $w addtag config withtag $item + } + + set x 50 + set y 50 + set color LightSkyBlue1 + mkTextConfig $c $x $y -anchor se $color + mkTextConfig $c [expr $x+30] [expr $y] -anchor s $color + mkTextConfig $c [expr $x+60] [expr $y] -anchor sw $color + mkTextConfig $c [expr $x] [expr $y+30] -anchor e $color + mkTextConfig $c [expr $x+30] [expr $y+30] -anchor center $color + mkTextConfig $c [expr $x+60] [expr $y+30] -anchor w $color + mkTextConfig $c [expr $x] [expr $y+60] -anchor ne $color + mkTextConfig $c [expr $x+30] [expr $y+60] -anchor n $color + mkTextConfig $c [expr $x+60] [expr $y+60] -anchor nw $color + set item [$c create rect [expr $x+40] [expr $y+40] [expr $x+50] [expr $y+50] \ + -outline black -fill red] + $c bind $item <1> "$c itemconf text -anchor center" + $c create text [expr $x+45] [expr $y-5] -text {Text Position} -anchor s \ + -font -*-times-medium-r-normal--*-240-*-*-*-*-*-* -fill brown + + # Lastly, create some items that allow the text's justification to be + # changed. + + set x 350 + set y 50 + set color SeaGreen2 + mkTextConfig $c $x $y -justify left $color + mkTextConfig $c [expr $x+30] [expr $y] -justify center $color + mkTextConfig $c [expr $x+60] [expr $y] -justify right $color + $c create text [expr $x+45] [expr $y-5] -text {Justification} -anchor s \ + -font -*-times-medium-r-normal--*-240-*-*-*-*-*-* -fill brown + + $c bind config "textEnter $c" + $c bind config "$c itemconf current -fill \$textConfigFill" + + set textConfigFill {} + + proc textEnter {w} { + global textConfigFill + set textConfigFill [lindex [$w itemconfig current -fill] 4] + $w itemconfig current -fill black + } + + proc textInsert {w string} { + if {$string == ""} { + return + } + catch {$w dchars text sel.first sel.last} + $w insert text insert $string + } + + proc textPaste {w pos} { + catch { + $w insert text $pos [selection get] + } + } + + proc textB1Press {w x y} { + $w icursor current @$x,$y + $w focus current + focus $w + $w select from current @$x,$y + } + + proc textB1Move {w x y} { + $w select to current @$x,$y + } + + proc textBs {w} { + if ![catch {$w dchars text sel.first sel.last}] { + return + } + set char [expr {[$w index text insert] - 1}] + if {$char >= 0} {$w dchar text $char} + } + + proc textDel {w} { + if ![catch {$w dchars text sel.first sel.last}] { + return + } + $w dchars text insert + } diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/dialog1.tcl ./library/demos.jp/dialog1.tcl *** ../tk4.2/library/demos.jp/dialog1.tcl Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/dialog1.tcl Sun Nov 24 18:25:55 1996 *************** *** 0 **** --- 1,15 ---- + # dialog1.tcl -- + # + # This demonstration script creates a dialog box with a local grab. + # + # SCCS: @(#) dialog1.tcl 1.2 96/02/16 10:49:52 + + after idle {.dialog1.msg configure -wraplength 4i} + set i [tk_dialog .dialog1 "Dialog with local grab" {モーダルダイアログボックスです。Tk の "grab" コマンドを使用してダイアログボックスで「ローカルグラブ」しています。下のいずれかのボタンを実行することによって、このダイアログに答えるまで、このグラブによってアプリケーションの他のウィンドウでは、ポインタ関係のイベントを受け取ることができなくなっています。} \ + info 0 了解 キャンセル コード参照] + + switch $i { + 0 {puts "あなたは「了解」を押しましたね。"} + 1 {puts "あなたは「キャンセル」を押しましたね。"} + 2 {showCode .dialog1} + } diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/dialog2.tcl ./library/demos.jp/dialog2.tcl *** ../tk4.2/library/demos.jp/dialog2.tcl Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/dialog2.tcl Sun Nov 24 18:25:55 1996 *************** *** 0 **** --- 1,19 ---- + # dialog2.tcl -- + # + # This demonstration script creates a dialog box with a global grab. + # + # SCCS: @(#) dialog2.tcl 1.2 96/02/16 10:49:53 + + after idle { + .dialog2.msg configure -wraplength 4i + } + after 100 { + grab -global .dialog2 + } + set i [tk_dialog .dialog2 "Dialog with local grab" {このダイアログボックスはグローバルグラブを使用しています。下のボタンを実行するまで、ディスプレイ上のいかなるものとも対話できません。グローバルグラブを使用することは、まず良い考えではありません。どうしても必要になるまで使おうと思わないで下さい。} warning 0 了解 キャンセル コード参照] + + switch $i { + 0 {puts "あなたは「了解」を押しましたね。"} + 1 {puts "あなたは「キャンセル」を押しましたね。"} + 2 {showCode .dialog2} + } diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/entry1.tcl ./library/demos.jp/entry1.tcl *** ../tk4.2/library/demos.jp/entry1.tcl Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/entry1.tcl Sun Nov 24 18:25:55 1996 *************** *** 0 **** --- 1,33 ---- + # entry1.tcl -- + # + # This demonstration script creates several entry widgets without + # scrollbars. + # + # SCCS: @(#) entry1.tcl 1.3 96/02/16 10:49:44 + + set w .entry1 + catch {destroy $w} + toplevel $w + wm title $w "Entry Demonstration (no scrollbars)" + wm iconname $w "entry1" + positionWindow $w + + label $w.msg -font $font -wraplength 5i -justify left -text "3種類の異なるエントリが表示されています。文字を入力するにはポインタを持って行き、クリックしてからタイプしてください。標準的な Motif の編集機能が、Emacs のキーバインドとともに、サポートされています。例えば、バックスペースとコントロール-H はカーソルの左の文字を削除し、デリートキーとコントロール-D はカーソルの右側の文字を削除します。長過ぎてウィンドウに入り切らないものは、マウスのボタン2 を押したままドラッグすることでスクロールさせることができます。日本語を入力するのはコントロール-バックスラッシュです。kinput2 が動いていれば入力することができます。" + pack $w.msg -side top + + frame $w.buttons + pack $w.buttons -side bottom -fill x -pady 2m + button $w.buttons.dismiss -text 了解 -command "destroy $w" + button $w.buttons.code -text "コード参照" -command "showCode $w" + pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 + + entry $w.e1 -relief sunken + entry $w.e2 -relief sunken + entry $w.e3 -relief sunken + pack $w.e1 $w.e2 $w.e3 -side top -pady 5 -padx 10 -fill x + + $w.e1 insert 0 "初期値" + $w.e2 insert end "このエントリには長い文字列が入っていて、" + $w.e2 insert end "長すぎてウィンドウには入り切らないので、" + $w.e2 insert end "実際の所終りまで見るにはスクロールさせなければ" + $w.e2 insert end "ならないでしょう。" diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/entry2.tcl ./library/demos.jp/entry2.tcl *** ../tk4.2/library/demos.jp/entry2.tcl Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/entry2.tcl Sun Nov 24 18:25:55 1996 *************** *** 0 **** --- 1,45 ---- + # entry2.tcl -- + # + # This demonstration script is the same as the entry1.tcl script + # except that it creates scrollbars for the entries. + # + # SCCS: @(#) entry2.tcl 1.3 96/02/16 10:49:45 + + set w .entry2 + catch {destroy $w} + toplevel $w + wm title $w "Entry Demonstration (with scrollbars)" + wm iconname $w "entry2" + positionWindow $w + + label $w.msg -font $font -wraplength 5i -justify left -text "3種類の異なるエントリが各々スクロールバー付で表示されています。文字を入力するにはポインタを持って行き、クリックしてからタイプしてください。標準的な Motif の編集機能が、 Emacs のキーバインドとともにサポートされています。例えば、バックスペースとコントロール-H はカーソルの左の文字を削除し、デリートキーとコントロール-D はカーソルの右側の文字を削除します。長過ぎてウィンドウに入り切らないものは、マウスのボタン2 を押したままドラッグすることでスクロールさせることができます。日本語を入力するのはコントロール-バックスラッシュです。kinput2 が動いていれば入力することができます。" + pack $w.msg -side top + + frame $w.buttons + pack $w.buttons -side bottom -fill x -pady 2m + button $w.buttons.dismiss -text 了解 -command "destroy $w" + button $w.buttons.code -text "コード参照" -command "showCode $w" + pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 + + frame $w.frame -borderwidth 10 + pack $w.frame -side top -fill x -expand 1 + + entry $w.frame.e1 -relief sunken -xscrollcommand "$w.frame.s1 set" + scrollbar $w.frame.s1 -relief sunken -orient horiz -command \ + "$w.frame.e1 xview" + frame $w.frame.spacer1 -width 20 -height 10 + entry $w.frame.e2 -relief sunken -xscrollcommand "$w.frame.s2 set" + scrollbar $w.frame.s2 -relief sunken -orient horiz -command \ + "$w.frame.e2 xview" + frame $w.frame.spacer2 -width 20 -height 10 + entry $w.frame.e3 -relief sunken -xscrollcommand "$w.frame.s3 set" + scrollbar $w.frame.s3 -relief sunken -orient horiz -command \ + "$w.frame.e3 xview" + pack $w.frame.e1 $w.frame.s1 $w.frame.spacer1 $w.frame.e2 $w.frame.s2 \ + $w.frame.spacer2 $w.frame.e3 $w.frame.s3 -side top -fill x + + $w.frame.e1 insert 0 "初期値" + $w.frame.e2 insert end "このエントリには長い文字列が入っていて、" + $w.frame.e2 insert end "長すぎてウィンドウには入り切らないので、" + $w.frame.e2 insert end "実際の所終りまで見るにはスクロールさせなければ" + $w.frame.e2 insert end "ならないでしょう。" diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/filebox.tcl ./library/demos.jp/filebox.tcl *** ../tk4.2/library/demos.jp/filebox.tcl Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/filebox.tcl Sun Nov 24 18:30:19 1996 *************** *** 0 **** --- 1,66 ---- + # filebox.tcl -- + # + # This demonstration script prompts the user to select a file. + # + # SCCS: @(#) filebox.tcl 1.2 96/08/27 15:03:26 + + set w .filebox + catch {destroy $w} + toplevel $w + wm title $w "File Selection Dialogs" + wm iconname $w "filebox" + positionWindow $w + + label $w.msg -font $font -wraplength 4i -justify left -text "Ggt@CA\"Browse\" {^t@CI_CAOt@CIB" + pack $w.msg -side top + + frame $w.buttons + pack $w.buttons -side bottom -fill x -pady 2m + button $w.buttons.dismiss -text -command "destroy $w" + button $w.buttons.code -text R[hQ -command "showCode $w" + pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 + + foreach i {J } { + set f [frame $w.$i] + label $f.lab -text "t@C$i: " -anchor e + entry $f.ent -width 20 + button $f.but -text "Browse ..." -command "fileDialog $w $f.ent $i" + pack $f.lab -side left + pack $f.ent -side left -expand yes -fill x + pack $f.but -side left + pack $f -fill x -padx 1c -pady 3 + } + + if ![string compare $tcl_platform(platform) unix] { + checkbutton $w.strict -text "MotifX^C_CAOp" \ + -variable tk_strictMotif -onvalue 1 -offvalue 0 + pack $w.strict -anchor c + } + + proc fileDialog {w ent operation} { + # Type names Extension(s) Mac File Type(s) + # + #--------------------------------------------------------- + set types { + {"Text files" {.txt .doc} } + {"Text files" {} TEXT} + {"Tcl Scripts" {.tcl} TEXT} + {"C Source Files" {.c .h} } + {"All Source Files" {.tcl .c .h} } + {"Image Files" {.gif} } + {"Image Files" {.jpeg .jpg} } + {"Image Files" "" {GIFF JPEG}} + {"All files" *} + } + if {$operation == "open"} { + set file [tk_getOpenFile -filetypes $types -parent $w] + } else { + set file [tk_getSaveFile -filetypes $types -parent $w \ + -initialfile Untitled -defaultextension .txt] + } + if [string compare $file ""] { + $ent delete 0 end + $ent insert 0 $file + $ent xview end + } + } diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/floor.tcl ./library/demos.jp/floor.tcl *** ../tk4.2/library/demos.jp/floor.tcl Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/floor.tcl Sun Nov 24 18:25:55 1996 *************** *** 0 **** --- 1,1366 ---- + # floor.tcl -- + # + # This demonstration script creates a canvas widet that displays the + # floorplan for DEC's Western Research Laboratory. + # + # SCCS: @(#) floor.tcl 1.5 96/10/04 17:09:37 + + # floorDisplay -- + # Recreate the floorplan display in the canvas given by "w". The + # floor given by "active" is displayed on top with its office structure + # visible. + # + # Arguments: + # w - Name of the canvas window. + # active - Number of active floor (1, 2, or 3). + + proc floorDisplay {w active} { + global floorLabels floorItems colors activeFloor + + if {$activeFloor == $active} { + return + } + + $w delete all + set activeFloor $active + + # First go through the three floors, displaying the backgrounds for + # each floor. + + bg1 $w $colors(bg1) $colors(outline1) + bg2 $w $colors(bg2) $colors(outline2) + bg3 $w $colors(bg3) $colors(outline3) + + # Raise the background for the active floor so that it's on top. + + $w raise floor$active + + # Create a dummy item just to mark this point in the display list, + # so we can insert highlights here. + + $w create rect 0 100 1 101 -fill {} -outline {} -tags marker + + # Add the walls and labels for the active floor, along with + # transparent polygons that define the rooms on the floor. + # Make sure that the room polygons are on top. + + catch {unset floorLabels} + catch {unset floorItems} + fg$active $w $colors(offices) + $w raise room + + # Offset the floors diagonally from each other. + + $w move floor1 2c 2c + $w move floor2 1c 1c + + # Create items for the room entry and its label. + + $w create window 600 100 -anchor w -window $w.entry + $w create text 600 100 -anchor e -text "部屋番号: " + $w config -scrollregion [$w bbox all] + } + + # newRoom -- + # This procedure is invoked whenever the mouse enters a room + # in the floorplan. It changes tags so that the current room is + # highlighted. + # + # Arguments: + # w - The name of the canvas window. + + proc newRoom w { + global currentRoom floorLabels + + set id [$w find withtag current] + if {$id != ""} { + set currentRoom $floorLabels($id) + } + update idletasks + } + + # roomChanged -- + # This procedure is invoked whenever the currentRoom variable changes. + # It highlights the current room and unhighlights any previous room. + # + # Arguments: + # w - The canvas window displaying the floorplan. + # args - Not used. + + proc roomChanged {w args} { + global currentRoom floorItems colors + $w delete highlight + if [catch {set item $floorItems($currentRoom)}] { + return + } + set new [eval \ + "$w create polygon [$w coords $item] -fill $colors(active) \ + -tags highlight"] + $w raise $new marker + } + + # bg1 -- + # This procedure represents part of the floorplan database. When + # invoked, it instantiates the background information for the first + # floor. + # + # Arguments: + # w - The canvas window. + # fill - Fill color to use for the floor's background. + # outline - Color to use for the floor's outline. + + proc bg1 {w fill outline} { + $w create poly 347 80 349 82 351 84 353 85 363 92 375 99 386 104 \ + 386 129 398 129 398 162 484 162 484 129 559 129 559 133 725 \ + 133 725 129 802 129 802 389 644 389 644 391 559 391 559 327 \ + 508 327 508 311 484 311 484 278 395 278 395 288 400 288 404 \ + 288 409 290 413 292 418 297 421 302 422 309 421 318 417 325 \ + 411 330 405 332 397 333 344 333 340 334 336 336 335 338 332 \ + 342 331 347 332 351 334 354 336 357 341 359 340 360 335 363 \ + 331 365 326 366 304 366 304 355 258 355 258 387 60 387 60 391 \ + 0 391 0 337 3 337 3 114 8 114 8 25 30 25 30 5 93 5 98 5 104 7 \ + 110 10 116 16 119 20 122 28 123 32 123 68 220 68 220 34 221 \ + 22 223 17 227 13 231 8 236 4 242 2 246 0 260 0 283 1 300 5 \ + 321 14 335 22 348 25 365 29 363 39 358 48 352 56 337 70 \ + 344 76 347 80 \ + -tags {floor1 bg} -fill $fill + $w create line 386 129 398 129 -fill $outline -tags {floor1 bg} + $w create line 258 355 258 387 -fill $outline -tags {floor1 bg} + $w create line 60 387 60 391 -fill $outline -tags {floor1 bg} + $w create line 0 337 0 391 -fill $outline -tags {floor1 bg} + $w create line 60 391 0 391 -fill $outline -tags {floor1 bg} + $w create line 3 114 3 337 -fill $outline -tags {floor1 bg} + $w create line 258 387 60 387 -fill $outline -tags {floor1 bg} + $w create line 484 162 398 162 -fill $outline -tags {floor1 bg} + $w create line 398 162 398 129 -fill $outline -tags {floor1 bg} + $w create line 484 278 484 311 -fill $outline -tags {floor1 bg} + $w create line 484 311 508 311 -fill $outline -tags {floor1 bg} + $w create line 508 327 508 311 -fill $outline -tags {floor1 bg} + $w create line 559 327 508 327 -fill $outline -tags {floor1 bg} + $w create line 644 391 559 391 -fill $outline -tags {floor1 bg} + $w create line 644 389 644 391 -fill $outline -tags {floor1 bg} + $w create line 559 129 484 129 -fill $outline -tags {floor1 bg} + $w create line 484 162 484 129 -fill $outline -tags {floor1 bg} + $w create line 725 133 559 133 -fill $outline -tags {floor1 bg} + $w create line 559 129 559 133 -fill $outline -tags {floor1 bg} + $w create line 725 129 802 129 -fill $outline -tags {floor1 bg} + $w create line 802 389 802 129 -fill $outline -tags {floor1 bg} + $w create line 3 337 0 337 -fill $outline -tags {floor1 bg} + $w create line 559 391 559 327 -fill $outline -tags {floor1 bg} + $w create line 802 389 644 389 -fill $outline -tags {floor1 bg} + $w create line 725 133 725 129 -fill $outline -tags {floor1 bg} + $w create line 8 25 8 114 -fill $outline -tags {floor1 bg} + $w create line 8 114 3 114 -fill $outline -tags {floor1 bg} + $w create line 30 25 8 25 -fill $outline -tags {floor1 bg} + $w create line 484 278 395 278 -fill $outline -tags {floor1 bg} + $w create line 30 25 30 5 -fill $outline -tags {floor1 bg} + $w create line 93 5 30 5 -fill $outline -tags {floor1 bg} + $w create line 98 5 93 5 -fill $outline -tags {floor1 bg} + $w create line 104 7 98 5 -fill $outline -tags {floor1 bg} + $w create line 110 10 104 7 -fill $outline -tags {floor1 bg} + $w create line 116 16 110 10 -fill $outline -tags {floor1 bg} + $w create line 119 20 116 16 -fill $outline -tags {floor1 bg} + $w create line 122 28 119 20 -fill $outline -tags {floor1 bg} + $w create line 123 32 122 28 -fill $outline -tags {floor1 bg} + $w create line 123 68 123 32 -fill $outline -tags {floor1 bg} + $w create line 220 68 123 68 -fill $outline -tags {floor1 bg} + $w create line 386 129 386 104 -fill $outline -tags {floor1 bg} + $w create line 386 104 375 99 -fill $outline -tags {floor1 bg} + $w create line 375 99 363 92 -fill $outline -tags {floor1 bg} + $w create line 353 85 363 92 -fill $outline -tags {floor1 bg} + $w create line 220 68 220 34 -fill $outline -tags {floor1 bg} + $w create line 337 70 352 56 -fill $outline -tags {floor1 bg} + $w create line 352 56 358 48 -fill $outline -tags {floor1 bg} + $w create line 358 48 363 39 -fill $outline -tags {floor1 bg} + $w create line 363 39 365 29 -fill $outline -tags {floor1 bg} + $w create line 365 29 348 25 -fill $outline -tags {floor1 bg} + $w create line 348 25 335 22 -fill $outline -tags {floor1 bg} + $w create line 335 22 321 14 -fill $outline -tags {floor1 bg} + $w create line 321 14 300 5 -fill $outline -tags {floor1 bg} + $w create line 300 5 283 1 -fill $outline -tags {floor1 bg} + $w create line 283 1 260 0 -fill $outline -tags {floor1 bg} + $w create line 260 0 246 0 -fill $outline -tags {floor1 bg} + $w create line 246 0 242 2 -fill $outline -tags {floor1 bg} + $w create line 242 2 236 4 -fill $outline -tags {floor1 bg} + $w create line 236 4 231 8 -fill $outline -tags {floor1 bg} + $w create line 231 8 227 13 -fill $outline -tags {floor1 bg} + $w create line 223 17 227 13 -fill $outline -tags {floor1 bg} + $w create line 221 22 223 17 -fill $outline -tags {floor1 bg} + $w create line 220 34 221 22 -fill $outline -tags {floor1 bg} + $w create line 340 360 335 363 -fill $outline -tags {floor1 bg} + $w create line 335 363 331 365 -fill $outline -tags {floor1 bg} + $w create line 331 365 326 366 -fill $outline -tags {floor1 bg} + $w create line 326 366 304 366 -fill $outline -tags {floor1 bg} + $w create line 304 355 304 366 -fill $outline -tags {floor1 bg} + $w create line 395 288 400 288 -fill $outline -tags {floor1 bg} + $w create line 404 288 400 288 -fill $outline -tags {floor1 bg} + $w create line 409 290 404 288 -fill $outline -tags {floor1 bg} + $w create line 413 292 409 290 -fill $outline -tags {floor1 bg} + $w create line 418 297 413 292 -fill $outline -tags {floor1 bg} + $w create line 421 302 418 297 -fill $outline -tags {floor1 bg} + $w create line 422 309 421 302 -fill $outline -tags {floor1 bg} + $w create line 421 318 422 309 -fill $outline -tags {floor1 bg} + $w create line 421 318 417 325 -fill $outline -tags {floor1 bg} + $w create line 417 325 411 330 -fill $outline -tags {floor1 bg} + $w create line 411 330 405 332 -fill $outline -tags {floor1 bg} + $w create line 405 332 397 333 -fill $outline -tags {floor1 bg} + $w create line 397 333 344 333 -fill $outline -tags {floor1 bg} + $w create line 344 333 340 334 -fill $outline -tags {floor1 bg} + $w create line 340 334 336 336 -fill $outline -tags {floor1 bg} + $w create line 336 336 335 338 -fill $outline -tags {floor1 bg} + $w create line 335 338 332 342 -fill $outline -tags {floor1 bg} + $w create line 331 347 332 342 -fill $outline -tags {floor1 bg} + $w create line 332 351 331 347 -fill $outline -tags {floor1 bg} + $w create line 334 354 332 351 -fill $outline -tags {floor1 bg} + $w create line 336 357 334 354 -fill $outline -tags {floor1 bg} + $w create line 341 359 336 357 -fill $outline -tags {floor1 bg} + $w create line 341 359 340 360 -fill $outline -tags {floor1 bg} + $w create line 395 288 395 278 -fill $outline -tags {floor1 bg} + $w create line 304 355 258 355 -fill $outline -tags {floor1 bg} + $w create line 347 80 344 76 -fill $outline -tags {floor1 bg} + $w create line 344 76 337 70 -fill $outline -tags {floor1 bg} + $w create line 349 82 347 80 -fill $outline -tags {floor1 bg} + $w create line 351 84 349 82 -fill $outline -tags {floor1 bg} + $w create line 353 85 351 84 -fill $outline -tags {floor1 bg} + } + + # bg2 -- + # This procedure represents part of the floorplan database. When + # invoked, it instantiates the background information for the second + # floor. + # + # Arguments: + # w - The canvas window. + # fill - Fill color to use for the floor's background. + # outline - Color to use for the floor's outline. + + proc bg2 {w fill outline} { + $w create poly 559 129 484 129 484 162 398 162 398 129 315 129 \ + 315 133 176 133 176 129 96 129 96 133 3 133 3 339 0 339 0 391 \ + 60 391 60 387 258 387 258 329 350 329 350 311 395 311 395 280 \ + 484 280 484 311 508 311 508 327 558 327 558 391 644 391 644 \ + 367 802 367 802 129 725 129 725 133 559 133 559 129 \ + -tags {floor2 bg} -fill $fill + $w create line 350 311 350 329 -fill $outline -tags {floor2 bg} + $w create line 398 129 398 162 -fill $outline -tags {floor2 bg} + $w create line 802 367 802 129 -fill $outline -tags {floor2 bg} + $w create line 802 129 725 129 -fill $outline -tags {floor2 bg} + $w create line 725 133 725 129 -fill $outline -tags {floor2 bg} + $w create line 559 129 559 133 -fill $outline -tags {floor2 bg} + $w create line 559 133 725 133 -fill $outline -tags {floor2 bg} + $w create line 484 162 484 129 -fill $outline -tags {floor2 bg} + $w create line 559 129 484 129 -fill $outline -tags {floor2 bg} + $w create line 802 367 644 367 -fill $outline -tags {floor2 bg} + $w create line 644 367 644 391 -fill $outline -tags {floor2 bg} + $w create line 644 391 558 391 -fill $outline -tags {floor2 bg} + $w create line 558 327 558 391 -fill $outline -tags {floor2 bg} + $w create line 558 327 508 327 -fill $outline -tags {floor2 bg} + $w create line 508 327 508 311 -fill $outline -tags {floor2 bg} + $w create line 484 311 508 311 -fill $outline -tags {floor2 bg} + $w create line 484 280 484 311 -fill $outline -tags {floor2 bg} + $w create line 398 162 484 162 -fill $outline -tags {floor2 bg} + $w create line 484 280 395 280 -fill $outline -tags {floor2 bg} + $w create line 395 280 395 311 -fill $outline -tags {floor2 bg} + $w create line 258 387 60 387 -fill $outline -tags {floor2 bg} + $w create line 3 133 3 339 -fill $outline -tags {floor2 bg} + $w create line 3 339 0 339 -fill $outline -tags {floor2 bg} + $w create line 60 391 0 391 -fill $outline -tags {floor2 bg} + $w create line 0 339 0 391 -fill $outline -tags {floor2 bg} + $w create line 60 387 60 391 -fill $outline -tags {floor2 bg} + $w create line 258 329 258 387 -fill $outline -tags {floor2 bg} + $w create line 350 329 258 329 -fill $outline -tags {floor2 bg} + $w create line 395 311 350 311 -fill $outline -tags {floor2 bg} + $w create line 398 129 315 129 -fill $outline -tags {floor2 bg} + $w create line 176 133 315 133 -fill $outline -tags {floor2 bg} + $w create line 176 129 96 129 -fill $outline -tags {floor2 bg} + $w create line 3 133 96 133 -fill $outline -tags {floor2 bg} + $w create line 315 133 315 129 -fill $outline -tags {floor2 bg} + $w create line 176 133 176 129 -fill $outline -tags {floor2 bg} + $w create line 96 133 96 129 -fill $outline -tags {floor2 bg} + } + + # bg3 -- + # This procedure represents part of the floorplan database. When + # invoked, it instantiates the background information for the third + # floor. + # + # Arguments: + # w - The canvas window. + # fill - Fill color to use for the floor's background. + # outline - Color to use for the floor's outline. + + proc bg3 {w fill outline} { + $w create poly 159 300 107 300 107 248 159 248 159 129 96 129 96 \ + 133 21 133 21 331 0 331 0 391 60 391 60 370 159 370 159 300 \ + -tags {floor3 bg} -fill $fill + $w create poly 258 370 258 329 350 329 350 311 399 311 399 129 \ + 315 129 315 133 176 133 176 129 159 129 159 370 258 370 \ + -tags {floor3 bg} -fill $fill + $w create line 96 133 96 129 -fill $outline -tags {floor3 bg} + $w create line 176 129 96 129 -fill $outline -tags {floor3 bg} + $w create line 176 129 176 133 -fill $outline -tags {floor3 bg} + $w create line 315 133 176 133 -fill $outline -tags {floor3 bg} + $w create line 315 133 315 129 -fill $outline -tags {floor3 bg} + $w create line 399 129 315 129 -fill $outline -tags {floor3 bg} + $w create line 399 311 399 129 -fill $outline -tags {floor3 bg} + $w create line 399 311 350 311 -fill $outline -tags {floor3 bg} + $w create line 350 329 350 311 -fill $outline -tags {floor3 bg} + $w create line 350 329 258 329 -fill $outline -tags {floor3 bg} + $w create line 258 370 258 329 -fill $outline -tags {floor3 bg} + $w create line 60 370 258 370 -fill $outline -tags {floor3 bg} + $w create line 60 370 60 391 -fill $outline -tags {floor3 bg} + $w create line 60 391 0 391 -fill $outline -tags {floor3 bg} + $w create line 0 391 0 331 -fill $outline -tags {floor3 bg} + $w create line 21 331 0 331 -fill $outline -tags {floor3 bg} + $w create line 21 331 21 133 -fill $outline -tags {floor3 bg} + $w create line 96 133 21 133 -fill $outline -tags {floor3 bg} + $w create line 107 300 159 300 159 248 107 248 107 300 \ + -fill $outline -tags {floor3 bg} + } + + # fg1 -- + # This procedure represents part of the floorplan database. When + # invoked, it instantiates the foreground information for the first + # floor (office outlines and numbers). + # + # Arguments: + # w - The canvas window. + # color - Color to use for drawing foreground information. + + proc fg1 {w color} { + global floorLabels floorItems + set i [$w create polygon 375 246 375 172 341 172 341 246 -fill {} -tags {floor1 room}] + set floorLabels($i) 101 + set {floorItems(101)} $i + $w create text 358 209 -text 101 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 307 240 339 240 339 206 307 206 -fill {} -tags {floor1 room}] + set floorLabels($i) {Pub Lift1} + set {floorItems(Pub Lift1)} $i + $w create text 323 223 -text {Pub Lift1} -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 339 205 307 205 307 171 339 171 -fill {} -tags {floor1 room}] + set floorLabels($i) {Priv Lift1} + set {floorItems(Priv Lift1)} $i + $w create text 323 188 -text {Priv Lift1} -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 42 389 42 337 1 337 1 389 -fill {} -tags {floor1 room}] + set floorLabels($i) 110 + set {floorItems(110)} $i + $w create text 21.5 363 -text 110 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 59 389 59 385 90 385 90 337 44 337 44 389 -fill {} -tags {floor1 room}] + set floorLabels($i) 109 + set {floorItems(109)} $i + $w create text 67 363 -text 109 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 51 300 51 253 6 253 6 300 -fill {} -tags {floor1 room}] + set floorLabels($i) 111 + set {floorItems(111)} $i + $w create text 28.5 276.5 -text 111 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 98 248 98 309 79 309 79 248 -fill {} -tags {floor1 room}] + set floorLabels($i) 117B + set {floorItems(117B)} $i + $w create text 88.5 278.5 -text 117B -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 51 251 51 204 6 204 6 251 -fill {} -tags {floor1 room}] + set floorLabels($i) 112 + set {floorItems(112)} $i + $w create text 28.5 227.5 -text 112 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 6 156 51 156 51 203 6 203 -fill {} -tags {floor1 room}] + set floorLabels($i) 113 + set {floorItems(113)} $i + $w create text 28.5 179.5 -text 113 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 85 169 79 169 79 192 85 192 -fill {} -tags {floor1 room}] + set floorLabels($i) 117A + set {floorItems(117A)} $i + $w create text 82 180.5 -text 117A -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 77 302 77 168 53 168 53 302 -fill {} -tags {floor1 room}] + set floorLabels($i) 117 + set {floorItems(117)} $i + $w create text 65 235 -text 117 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 51 155 51 115 6 115 6 155 -fill {} -tags {floor1 room}] + set floorLabels($i) 114 + set {floorItems(114)} $i + $w create text 28.5 135 -text 114 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 95 115 53 115 53 168 95 168 -fill {} -tags {floor1 room}] + set floorLabels($i) 115 + set {floorItems(115)} $i + $w create text 74 141.5 -text 115 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 87 113 87 27 10 27 10 113 -fill {} -tags {floor1 room}] + set floorLabels($i) 116 + set {floorItems(116)} $i + $w create text 48.5 70 -text 116 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 89 91 128 91 128 113 89 113 -fill {} -tags {floor1 room}] + set floorLabels($i) 118 + set {floorItems(118)} $i + $w create text 108.5 102 -text 118 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 178 128 178 132 216 132 216 91 163 91 163 112 149 112 149 128 -fill {} -tags {floor1 room}] + set floorLabels($i) 120 + set {floorItems(120)} $i + $w create text 189.5 111.5 -text 120 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 79 193 87 193 87 169 136 169 136 192 156 192 156 169 175 169 175 246 79 246 -fill {} -tags {floor1 room}] + set floorLabels($i) 122 + set {floorItems(122)} $i + $w create text 131 207.5 -text 122 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 138 169 154 169 154 191 138 191 -fill {} -tags {floor1 room}] + set floorLabels($i) 121 + set {floorItems(121)} $i + $w create text 146 180 -text 121 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 99 300 126 300 126 309 99 309 -fill {} -tags {floor1 room}] + set floorLabels($i) 106A + set {floorItems(106A)} $i + $w create text 112.5 304.5 -text 106A -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 128 299 128 309 150 309 150 248 99 248 99 299 -fill {} -tags {floor1 room}] + set floorLabels($i) 105 + set {floorItems(105)} $i + $w create text 124.5 278.5 -text 105 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 174 309 174 300 152 300 152 309 -fill {} -tags {floor1 room}] + set floorLabels($i) 106B + set {floorItems(106B)} $i + $w create text 163 304.5 -text 106B -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 176 299 176 309 216 309 216 248 152 248 152 299 -fill {} -tags {floor1 room}] + set floorLabels($i) 104 + set {floorItems(104)} $i + $w create text 184 278.5 -text 104 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 138 385 138 337 91 337 91 385 -fill {} -tags {floor1 room}] + set floorLabels($i) 108 + set {floorItems(108)} $i + $w create text 114.5 361 -text 108 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 256 337 140 337 140 385 256 385 -fill {} -tags {floor1 room}] + set floorLabels($i) 107 + set {floorItems(107)} $i + $w create text 198 361 -text 107 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 300 353 300 329 260 329 260 353 -fill {} -tags {floor1 room}] + set floorLabels($i) Smoking + set {floorItems(Smoking)} $i + $w create text 280 341 -text Smoking -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 314 135 314 170 306 170 306 246 177 246 177 135 -fill {} -tags {floor1 room}] + set floorLabels($i) 123 + set {floorItems(123)} $i + $w create text 245.5 190.5 -text 123 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 217 248 301 248 301 326 257 326 257 310 217 310 -fill {} -tags {floor1 room}] + set floorLabels($i) 103 + set {floorItems(103)} $i + $w create text 259 287 -text 103 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 396 188 377 188 377 169 316 169 316 131 396 131 -fill {} -tags {floor1 room}] + set floorLabels($i) 124 + set {floorItems(124)} $i + $w create text 356 150 -text 124 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 397 226 407 226 407 189 377 189 377 246 397 246 -fill {} -tags {floor1 room}] + set floorLabels($i) 125 + set {floorItems(125)} $i + $w create text 392 217.5 -text 125 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 399 187 409 187 409 207 474 207 474 164 399 164 -fill {} -tags {floor1 room}] + set floorLabels($i) 126 + set {floorItems(126)} $i + $w create text 436.5 185.5 -text 126 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 409 209 409 229 399 229 399 253 486 253 486 239 474 239 474 209 -fill {} -tags {floor1 room}] + set floorLabels($i) 127 + set {floorItems(127)} $i + $w create text 436.5 231 -text 127 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 501 164 501 174 495 174 495 188 490 188 490 204 476 204 476 164 -fill {} -tags {floor1 room}] + set floorLabels($i) MShower + set {floorItems(MShower)} $i + $w create text 488.5 184 -text MShower -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 497 176 513 176 513 204 492 204 492 190 497 190 -fill {} -tags {floor1 room}] + set floorLabels($i) Closet + set {floorItems(Closet)} $i + $w create text 502.5 190 -text Closet -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 476 237 476 206 513 206 513 254 488 254 488 237 -fill {} -tags {floor1 room}] + set floorLabels($i) WShower + set {floorItems(WShower)} $i + $w create text 494.5 230 -text WShower -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 486 131 558 131 558 135 724 135 724 166 697 166 697 275 553 275 531 254 515 254 515 174 503 174 503 161 486 161 -fill {} -tags {floor1 room}] + set floorLabels($i) 130 + set {floorItems(130)} $i + $w create text 638.5 205 -text 130 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 308 242 339 242 339 248 342 248 342 246 397 246 397 276 393 276 393 309 300 309 300 248 308 248 -fill {} -tags {floor1 room}] + set floorLabels($i) 102 + set {floorItems(102)} $i + $w create text 367.5 278.5 -text 102 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 397 255 486 255 486 276 397 276 -fill {} -tags {floor1 room}] + set floorLabels($i) 128 + set {floorItems(128)} $i + $w create text 441.5 265.5 -text 128 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 510 309 486 309 486 255 530 255 552 277 561 277 561 325 510 325 -fill {} -tags {floor1 room}] + set floorLabels($i) 129 + set {floorItems(129)} $i + $w create text 535.5 293 -text 129 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 696 281 740 281 740 387 642 387 642 389 561 389 561 277 696 277 -fill {} -tags {floor1 room}] + set floorLabels($i) 133 + set {floorItems(133)} $i + $w create text 628.5 335 -text 133 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 742 387 742 281 800 281 800 387 -fill {} -tags {floor1 room}] + set floorLabels($i) 132 + set {floorItems(132)} $i + $w create text 771 334 -text 132 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 800 168 800 280 699 280 699 168 -fill {} -tags {floor1 room}] + set floorLabels($i) 134 + set {floorItems(134)} $i + $w create text 749.5 224 -text 134 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 726 131 726 166 800 166 800 131 -fill {} -tags {floor1 room}] + set floorLabels($i) 135 + set {floorItems(135)} $i + $w create text 763 148.5 -text 135 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 340 360 335 363 331 365 326 366 304 366 304 312 396 312 396 288 400 288 404 288 409 290 413 292 418 297 421 302 422 309 421 318 417 325 411 330 405 332 397 333 344 333 340 334 336 336 335 338 332 342 331 347 332 351 334 354 336 357 341 359 -fill {} -tags {floor1 room}] + set floorLabels($i) {Ramona Stair} + set {floorItems(Ramona Stair)} $i + $w create text 368 323 -text {Ramona Stair} -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 30 23 30 5 93 5 98 5 104 7 110 10 116 16 119 20 122 28 123 32 123 68 220 68 220 87 90 87 90 23 -fill {} -tags {floor1 room}] + set floorLabels($i) {University Stair} + set {floorItems(University Stair)} $i + $w create text 155 77.5 -text {University Stair} -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 282 37 295 40 312 49 323 56 337 70 352 56 358 48 363 39 365 29 348 25 335 22 321 14 300 5 283 1 260 0 246 0 242 2 236 4 231 8 227 13 223 17 221 22 220 34 260 34 -fill {} -tags {floor1 room}] + set floorLabels($i) {Plaza Stair} + set {floorItems(Plaza Stair)} $i + $w create text 317.5 28.5 -text {Plaza Stair} -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 220 34 260 34 282 37 295 40 312 49 323 56 337 70 350 83 365 94 377 100 386 104 386 128 220 128 -fill {} -tags {floor1 room}] + set floorLabels($i) {Plaza Deck} + set {floorItems(Plaza Deck)} $i + $w create text 303 81 -text {Plaza Deck} -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 257 336 77 336 6 336 6 301 77 301 77 310 257 310 -fill {} -tags {floor1 room}] + set floorLabels($i) 106 + set {floorItems(106)} $i + $w create text 131.5 318.5 -text 106 -fill $color -anchor c -tags {floor1 label} + set i [$w create polygon 146 110 162 110 162 91 130 91 130 115 95 115 95 128 114 128 114 151 157 151 157 153 112 153 112 130 97 130 97 168 175 168 175 131 146 131 -fill {} -tags {floor1 room}] + set floorLabels($i) 119 + set {floorItems(119)} $i + $w create text 143.5 133 -text 119 -fill $color -anchor c -tags {floor1 label} + $w create line 155 191 155 189 -fill $color -tags {floor1 wall} + $w create line 155 177 155 169 -fill $color -tags {floor1 wall} + $w create line 96 129 96 169 -fill $color -tags {floor1 wall} + $w create line 78 169 176 169 -fill $color -tags {floor1 wall} + $w create line 176 247 176 129 -fill $color -tags {floor1 wall} + $w create line 340 206 307 206 -fill $color -tags {floor1 wall} + $w create line 340 187 340 170 -fill $color -tags {floor1 wall} + $w create line 340 210 340 201 -fill $color -tags {floor1 wall} + $w create line 340 247 340 224 -fill $color -tags {floor1 wall} + $w create line 340 241 307 241 -fill $color -tags {floor1 wall} + $w create line 376 246 376 170 -fill $color -tags {floor1 wall} + $w create line 307 247 307 170 -fill $color -tags {floor1 wall} + $w create line 376 170 307 170 -fill $color -tags {floor1 wall} + $w create line 315 129 315 170 -fill $color -tags {floor1 wall} + $w create line 147 129 176 129 -fill $color -tags {floor1 wall} + $w create line 202 133 176 133 -fill $color -tags {floor1 wall} + $w create line 398 129 315 129 -fill $color -tags {floor1 wall} + $w create line 258 352 258 387 -fill $color -tags {floor1 wall} + $w create line 60 387 60 391 -fill $color -tags {floor1 wall} + $w create line 0 337 0 391 -fill $color -tags {floor1 wall} + $w create line 60 391 0 391 -fill $color -tags {floor1 wall} + $w create line 3 114 3 337 -fill $color -tags {floor1 wall} + $w create line 258 387 60 387 -fill $color -tags {floor1 wall} + $w create line 52 237 52 273 -fill $color -tags {floor1 wall} + $w create line 52 189 52 225 -fill $color -tags {floor1 wall} + $w create line 52 140 52 177 -fill $color -tags {floor1 wall} + $w create line 395 306 395 311 -fill $color -tags {floor1 wall} + $w create line 531 254 398 254 -fill $color -tags {floor1 wall} + $w create line 475 178 475 238 -fill $color -tags {floor1 wall} + $w create line 502 162 398 162 -fill $color -tags {floor1 wall} + $w create line 398 129 398 188 -fill $color -tags {floor1 wall} + $w create line 383 188 376 188 -fill $color -tags {floor1 wall} + $w create line 408 188 408 194 -fill $color -tags {floor1 wall} + $w create line 398 227 398 254 -fill $color -tags {floor1 wall} + $w create line 408 227 398 227 -fill $color -tags {floor1 wall} + $w create line 408 222 408 227 -fill $color -tags {floor1 wall} + $w create line 408 206 408 210 -fill $color -tags {floor1 wall} + $w create line 408 208 475 208 -fill $color -tags {floor1 wall} + $w create line 484 278 484 311 -fill $color -tags {floor1 wall} + $w create line 484 311 508 311 -fill $color -tags {floor1 wall} + $w create line 508 327 508 311 -fill $color -tags {floor1 wall} + $w create line 559 327 508 327 -fill $color -tags {floor1 wall} + $w create line 644 391 559 391 -fill $color -tags {floor1 wall} + $w create line 644 389 644 391 -fill $color -tags {floor1 wall} + $w create line 514 205 475 205 -fill $color -tags {floor1 wall} + $w create line 496 189 496 187 -fill $color -tags {floor1 wall} + $w create line 559 129 484 129 -fill $color -tags {floor1 wall} + $w create line 484 162 484 129 -fill $color -tags {floor1 wall} + $w create line 725 133 559 133 -fill $color -tags {floor1 wall} + $w create line 559 129 559 133 -fill $color -tags {floor1 wall} + $w create line 725 149 725 167 -fill $color -tags {floor1 wall} + $w create line 725 129 802 129 -fill $color -tags {floor1 wall} + $w create line 802 389 802 129 -fill $color -tags {floor1 wall} + $w create line 739 167 802 167 -fill $color -tags {floor1 wall} + $w create line 396 188 408 188 -fill $color -tags {floor1 wall} + $w create line 0 337 9 337 -fill $color -tags {floor1 wall} + $w create line 58 337 21 337 -fill $color -tags {floor1 wall} + $w create line 43 391 43 337 -fill $color -tags {floor1 wall} + $w create line 105 337 75 337 -fill $color -tags {floor1 wall} + $w create line 91 387 91 337 -fill $color -tags {floor1 wall} + $w create line 154 337 117 337 -fill $color -tags {floor1 wall} + $w create line 139 387 139 337 -fill $color -tags {floor1 wall} + $w create line 227 337 166 337 -fill $color -tags {floor1 wall} + $w create line 258 337 251 337 -fill $color -tags {floor1 wall} + $w create line 258 328 302 328 -fill $color -tags {floor1 wall} + $w create line 302 355 302 311 -fill $color -tags {floor1 wall} + $w create line 395 311 302 311 -fill $color -tags {floor1 wall} + $w create line 484 278 395 278 -fill $color -tags {floor1 wall} + $w create line 395 294 395 278 -fill $color -tags {floor1 wall} + $w create line 473 278 473 275 -fill $color -tags {floor1 wall} + $w create line 473 256 473 254 -fill $color -tags {floor1 wall} + $w create line 533 257 531 254 -fill $color -tags {floor1 wall} + $w create line 553 276 551 274 -fill $color -tags {floor1 wall} + $w create line 698 276 553 276 -fill $color -tags {floor1 wall} + $w create line 559 391 559 327 -fill $color -tags {floor1 wall} + $w create line 802 389 644 389 -fill $color -tags {floor1 wall} + $w create line 741 314 741 389 -fill $color -tags {floor1 wall} + $w create line 698 280 698 167 -fill $color -tags {floor1 wall} + $w create line 707 280 698 280 -fill $color -tags {floor1 wall} + $w create line 802 280 731 280 -fill $color -tags {floor1 wall} + $w create line 741 280 741 302 -fill $color -tags {floor1 wall} + $w create line 698 167 727 167 -fill $color -tags {floor1 wall} + $w create line 725 137 725 129 -fill $color -tags {floor1 wall} + $w create line 514 254 514 175 -fill $color -tags {floor1 wall} + $w create line 496 175 514 175 -fill $color -tags {floor1 wall} + $w create line 502 175 502 162 -fill $color -tags {floor1 wall} + $w create line 475 166 475 162 -fill $color -tags {floor1 wall} + $w create line 496 176 496 175 -fill $color -tags {floor1 wall} + $w create line 491 189 496 189 -fill $color -tags {floor1 wall} + $w create line 491 205 491 189 -fill $color -tags {floor1 wall} + $w create line 487 238 475 238 -fill $color -tags {floor1 wall} + $w create line 487 240 487 238 -fill $color -tags {floor1 wall} + $w create line 487 252 487 254 -fill $color -tags {floor1 wall} + $w create line 315 133 304 133 -fill $color -tags {floor1 wall} + $w create line 256 133 280 133 -fill $color -tags {floor1 wall} + $w create line 78 247 270 247 -fill $color -tags {floor1 wall} + $w create line 307 247 294 247 -fill $color -tags {floor1 wall} + $w create line 214 133 232 133 -fill $color -tags {floor1 wall} + $w create line 217 247 217 266 -fill $color -tags {floor1 wall} + $w create line 217 309 217 291 -fill $color -tags {floor1 wall} + $w create line 217 309 172 309 -fill $color -tags {floor1 wall} + $w create line 154 309 148 309 -fill $color -tags {floor1 wall} + $w create line 175 300 175 309 -fill $color -tags {floor1 wall} + $w create line 151 300 175 300 -fill $color -tags {floor1 wall} + $w create line 151 247 151 309 -fill $color -tags {floor1 wall} + $w create line 78 237 78 265 -fill $color -tags {floor1 wall} + $w create line 78 286 78 309 -fill $color -tags {floor1 wall} + $w create line 106 309 78 309 -fill $color -tags {floor1 wall} + $w create line 130 309 125 309 -fill $color -tags {floor1 wall} + $w create line 99 309 99 247 -fill $color -tags {floor1 wall} + $w create line 127 299 99 299 -fill $color -tags {floor1 wall} + $w create line 127 309 127 299 -fill $color -tags {floor1 wall} + $w create line 155 191 137 191 -fill $color -tags {floor1 wall} + $w create line 137 169 137 191 -fill $color -tags {floor1 wall} + $w create line 78 171 78 169 -fill $color -tags {floor1 wall} + $w create line 78 190 78 218 -fill $color -tags {floor1 wall} + $w create line 86 192 86 169 -fill $color -tags {floor1 wall} + $w create line 86 192 78 192 -fill $color -tags {floor1 wall} + $w create line 52 301 3 301 -fill $color -tags {floor1 wall} + $w create line 52 286 52 301 -fill $color -tags {floor1 wall} + $w create line 52 252 3 252 -fill $color -tags {floor1 wall} + $w create line 52 203 3 203 -fill $color -tags {floor1 wall} + $w create line 3 156 52 156 -fill $color -tags {floor1 wall} + $w create line 8 25 8 114 -fill $color -tags {floor1 wall} + $w create line 63 114 3 114 -fill $color -tags {floor1 wall} + $w create line 75 114 97 114 -fill $color -tags {floor1 wall} + $w create line 108 114 129 114 -fill $color -tags {floor1 wall} + $w create line 129 114 129 89 -fill $color -tags {floor1 wall} + $w create line 52 114 52 128 -fill $color -tags {floor1 wall} + $w create line 132 89 88 89 -fill $color -tags {floor1 wall} + $w create line 88 25 88 89 -fill $color -tags {floor1 wall} + $w create line 88 114 88 89 -fill $color -tags {floor1 wall} + $w create line 218 89 144 89 -fill $color -tags {floor1 wall} + $w create line 147 111 147 129 -fill $color -tags {floor1 wall} + $w create line 162 111 147 111 -fill $color -tags {floor1 wall} + $w create line 162 109 162 111 -fill $color -tags {floor1 wall} + $w create line 162 96 162 89 -fill $color -tags {floor1 wall} + $w create line 218 89 218 94 -fill $color -tags {floor1 wall} + $w create line 218 89 218 119 -fill $color -tags {floor1 wall} + $w create line 8 25 88 25 -fill $color -tags {floor1 wall} + $w create line 258 337 258 328 -fill $color -tags {floor1 wall} + $w create line 113 129 96 129 -fill $color -tags {floor1 wall} + $w create line 302 355 258 355 -fill $color -tags {floor1 wall} + $w create line 386 104 386 129 -fill $color -tags {floor1 wall} + $w create line 377 100 386 104 -fill $color -tags {floor1 wall} + $w create line 365 94 377 100 -fill $color -tags {floor1 wall} + $w create line 350 83 365 94 -fill $color -tags {floor1 wall} + $w create line 337 70 350 83 -fill $color -tags {floor1 wall} + $w create line 337 70 323 56 -fill $color -tags {floor1 wall} + $w create line 312 49 323 56 -fill $color -tags {floor1 wall} + $w create line 295 40 312 49 -fill $color -tags {floor1 wall} + $w create line 282 37 295 40 -fill $color -tags {floor1 wall} + $w create line 260 34 282 37 -fill $color -tags {floor1 wall} + $w create line 253 34 260 34 -fill $color -tags {floor1 wall} + $w create line 386 128 386 104 -fill $color -tags {floor1 wall} + $w create line 113 152 156 152 -fill $color -tags {floor1 wall} + $w create line 113 152 156 152 -fill $color -tags {floor1 wall} + $w create line 113 152 113 129 -fill $color -tags {floor1 wall} + } + + # fg2 -- + # This procedure represents part of the floorplan database. When + # invoked, it instantiates the foreground information for the second + # floor (office outlines and numbers). + # + # Arguments: + # w - The canvas window. + # color - Color to use for drawing foreground information. + + proc fg2 {w color} { + global floorLabels floorItems + set i [$w create polygon 748 188 755 188 755 205 758 205 758 222 800 222 800 168 748 168 -fill {} -tags {floor2 room}] + set floorLabels($i) 238 + set {floorItems(238)} $i + $w create text 774 195 -text 238 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 726 188 746 188 746 166 800 166 800 131 726 131 -fill {} -tags {floor2 room}] + set floorLabels($i) 237 + set {floorItems(237)} $i + $w create text 763 148.5 -text 237 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 497 187 497 204 559 204 559 324 641 324 643 324 643 291 641 291 641 205 696 205 696 291 694 291 694 314 715 314 715 291 715 205 755 205 755 190 724 190 724 187 -fill {} -tags {floor2 room}] + set floorLabels($i) 246 + set {floorItems(246)} $i + $w create text 600 264 -text 246 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 694 279 643 279 643 314 694 314 -fill {} -tags {floor2 room}] + set floorLabels($i) 247 + set {floorItems(247)} $i + $w create text 668.5 296.5 -text 247 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 232 250 308 250 308 242 339 242 339 246 397 246 397 255 476 255 476 250 482 250 559 250 559 274 482 274 482 278 396 278 396 274 232 274 -fill {} -tags {floor2 room}] + set floorLabels($i) 202 + set {floorItems(202)} $i + $w create text 285.5 260 -text 202 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 53 228 53 338 176 338 233 338 233 196 306 196 306 180 175 180 175 169 156 169 156 196 176 196 176 228 -fill {} -tags {floor2 room}] + set floorLabels($i) 206 + set {floorItems(206)} $i + $w create text 143 267 -text 206 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 51 277 6 277 6 338 51 338 -fill {} -tags {floor2 room}] + set floorLabels($i) 212 + set {floorItems(212)} $i + $w create text 28.5 307.5 -text 212 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 557 276 486 276 486 309 510 309 510 325 557 325 -fill {} -tags {floor2 room}] + set floorLabels($i) 245 + set {floorItems(245)} $i + $w create text 521.5 300.5 -text 245 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 560 389 599 389 599 326 560 326 -fill {} -tags {floor2 room}] + set floorLabels($i) 244 + set {floorItems(244)} $i + $w create text 579.5 357.5 -text 244 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 601 389 601 326 643 326 643 389 -fill {} -tags {floor2 room}] + set floorLabels($i) 243 + set {floorItems(243)} $i + $w create text 622 357.5 -text 243 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 688 316 645 316 645 365 688 365 -fill {} -tags {floor2 room}] + set floorLabels($i) 242 + set {floorItems(242)} $i + $w create text 666.5 340.5 -text 242 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 802 367 759 367 759 226 802 226 -fill {} -tags {floor2 room}] + set floorLabels($i) {Barbecue Deck} + set {floorItems(Barbecue Deck)} $i + $w create text 780.5 296.5 -text {Barbecue Deck} -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 755 262 755 314 717 314 717 262 -fill {} -tags {floor2 room}] + set floorLabels($i) 240 + set {floorItems(240)} $i + $w create text 736 288 -text 240 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 755 316 689 316 689 365 755 365 -fill {} -tags {floor2 room}] + set floorLabels($i) 241 + set {floorItems(241)} $i + $w create text 722 340.5 -text 241 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 755 206 717 206 717 261 755 261 -fill {} -tags {floor2 room}] + set floorLabels($i) 239 + set {floorItems(239)} $i + $w create text 736 233.5 -text 239 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 695 277 643 277 643 206 695 206 -fill {} -tags {floor2 room}] + set floorLabels($i) 248 + set {floorItems(248)} $i + $w create text 669 241.5 -text 248 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 676 135 676 185 724 185 724 135 -fill {} -tags {floor2 room}] + set floorLabels($i) 236 + set {floorItems(236)} $i + $w create text 700 160 -text 236 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 675 135 635 135 635 145 628 145 628 185 675 185 -fill {} -tags {floor2 room}] + set floorLabels($i) 235 + set {floorItems(235)} $i + $w create text 651.5 160 -text 235 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 626 143 633 143 633 135 572 135 572 143 579 143 579 185 626 185 -fill {} -tags {floor2 room}] + set floorLabels($i) 234 + set {floorItems(234)} $i + $w create text 606 160 -text 234 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 557 135 571 135 571 145 578 145 578 185 527 185 527 131 557 131 -fill {} -tags {floor2 room}] + set floorLabels($i) 233 + set {floorItems(233)} $i + $w create text 552.5 158 -text 233 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 476 249 557 249 557 205 476 205 -fill {} -tags {floor2 room}] + set floorLabels($i) 230 + set {floorItems(230)} $i + $w create text 516.5 227 -text 230 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 476 164 486 164 486 131 525 131 525 185 476 185 -fill {} -tags {floor2 room}] + set floorLabels($i) 232 + set {floorItems(232)} $i + $w create text 500.5 158 -text 232 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 476 186 495 186 495 204 476 204 -fill {} -tags {floor2 room}] + set floorLabels($i) 229 + set {floorItems(229)} $i + $w create text 485.5 195 -text 229 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 474 207 409 207 409 187 399 187 399 164 474 164 -fill {} -tags {floor2 room}] + set floorLabels($i) 227 + set {floorItems(227)} $i + $w create text 436.5 185.5 -text 227 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 399 228 399 253 474 253 474 209 409 209 409 228 -fill {} -tags {floor2 room}] + set floorLabels($i) 228 + set {floorItems(228)} $i + $w create text 436.5 231 -text 228 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 397 246 397 226 407 226 407 189 377 189 377 246 -fill {} -tags {floor2 room}] + set floorLabels($i) 226 + set {floorItems(226)} $i + $w create text 392 217.5 -text 226 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 377 169 316 169 316 131 397 131 397 188 377 188 -fill {} -tags {floor2 room}] + set floorLabels($i) 225 + set {floorItems(225)} $i + $w create text 356.5 150 -text 225 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 234 198 306 198 306 249 234 249 -fill {} -tags {floor2 room}] + set floorLabels($i) 224 + set {floorItems(224)} $i + $w create text 270 223.5 -text 224 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 270 179 306 179 306 170 314 170 314 135 270 135 -fill {} -tags {floor2 room}] + set floorLabels($i) 223 + set {floorItems(223)} $i + $w create text 292 157 -text 223 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 268 179 221 179 221 135 268 135 -fill {} -tags {floor2 room}] + set floorLabels($i) 222 + set {floorItems(222)} $i + $w create text 244.5 157 -text 222 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 177 179 219 179 219 135 177 135 -fill {} -tags {floor2 room}] + set floorLabels($i) 221 + set {floorItems(221)} $i + $w create text 198 157 -text 221 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 299 327 349 327 349 284 341 284 341 276 299 276 -fill {} -tags {floor2 room}] + set floorLabels($i) 204 + set {floorItems(204)} $i + $w create text 324 301.5 -text 204 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 234 276 297 276 297 327 257 327 257 338 234 338 -fill {} -tags {floor2 room}] + set floorLabels($i) 205 + set {floorItems(205)} $i + $w create text 265.5 307 -text 205 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 256 385 256 340 212 340 212 385 -fill {} -tags {floor2 room}] + set floorLabels($i) 207 + set {floorItems(207)} $i + $w create text 234 362.5 -text 207 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 210 340 164 340 164 385 210 385 -fill {} -tags {floor2 room}] + set floorLabels($i) 208 + set {floorItems(208)} $i + $w create text 187 362.5 -text 208 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 115 340 162 340 162 385 115 385 -fill {} -tags {floor2 room}] + set floorLabels($i) 209 + set {floorItems(209)} $i + $w create text 138.5 362.5 -text 209 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 89 228 89 156 53 156 53 228 -fill {} -tags {floor2 room}] + set floorLabels($i) 217 + set {floorItems(217)} $i + $w create text 71 192 -text 217 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 89 169 97 169 97 190 89 190 -fill {} -tags {floor2 room}] + set floorLabels($i) 217A + set {floorItems(217A)} $i + $w create text 93 179.5 -text 217A -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 89 156 89 168 95 168 95 135 53 135 53 156 -fill {} -tags {floor2 room}] + set floorLabels($i) 216 + set {floorItems(216)} $i + $w create text 71 145.5 -text 216 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 51 179 51 135 6 135 6 179 -fill {} -tags {floor2 room}] + set floorLabels($i) 215 + set {floorItems(215)} $i + $w create text 28.5 157 -text 215 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 51 227 6 227 6 180 51 180 -fill {} -tags {floor2 room}] + set floorLabels($i) 214 + set {floorItems(214)} $i + $w create text 28.5 203.5 -text 214 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 51 275 6 275 6 229 51 229 -fill {} -tags {floor2 room}] + set floorLabels($i) 213 + set {floorItems(213)} $i + $w create text 28.5 252 -text 213 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 114 340 67 340 67 385 114 385 -fill {} -tags {floor2 room}] + set floorLabels($i) 210 + set {floorItems(210)} $i + $w create text 90.5 362.5 -text 210 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 59 389 59 385 65 385 65 340 1 340 1 389 -fill {} -tags {floor2 room}] + set floorLabels($i) 211 + set {floorItems(211)} $i + $w create text 33 364.5 -text 211 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 393 309 350 309 350 282 342 282 342 276 393 276 -fill {} -tags {floor2 room}] + set floorLabels($i) 203 + set {floorItems(203)} $i + $w create text 367.5 292.5 -text 203 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 99 191 91 191 91 226 174 226 174 198 154 198 154 192 109 192 109 169 99 169 -fill {} -tags {floor2 room}] + set floorLabels($i) 220 + set {floorItems(220)} $i + $w create text 132.5 208.5 -text 220 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 339 205 307 205 307 171 339 171 -fill {} -tags {floor2 room}] + set floorLabels($i) {Priv Lift2} + set {floorItems(Priv Lift2)} $i + $w create text 323 188 -text {Priv Lift2} -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 307 240 339 240 339 206 307 206 -fill {} -tags {floor2 room}] + set floorLabels($i) {Pub Lift 2} + set {floorItems(Pub Lift 2)} $i + $w create text 323 223 -text {Pub Lift 2} -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 175 168 97 168 97 131 175 131 -fill {} -tags {floor2 room}] + set floorLabels($i) 218 + set {floorItems(218)} $i + $w create text 136 149.5 -text 218 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 154 191 111 191 111 169 154 169 -fill {} -tags {floor2 room}] + set floorLabels($i) 219 + set {floorItems(219)} $i + $w create text 132.5 180 -text 219 -fill $color -anchor c -tags {floor2 label} + set i [$w create polygon 375 246 375 172 341 172 341 246 -fill {} -tags {floor2 room}] + set floorLabels($i) 201 + set {floorItems(201)} $i + $w create text 358 209 -text 201 -fill $color -anchor c -tags {floor2 label} + $w create line 641 186 678 186 -fill $color -tags {floor2 wall} + $w create line 757 350 757 367 -fill $color -tags {floor2 wall} + $w create line 634 133 634 144 -fill $color -tags {floor2 wall} + $w create line 634 144 627 144 -fill $color -tags {floor2 wall} + $w create line 572 133 572 144 -fill $color -tags {floor2 wall} + $w create line 572 144 579 144 -fill $color -tags {floor2 wall} + $w create line 398 129 398 162 -fill $color -tags {floor2 wall} + $w create line 174 197 175 197 -fill $color -tags {floor2 wall} + $w create line 175 197 175 227 -fill $color -tags {floor2 wall} + $w create line 757 206 757 221 -fill $color -tags {floor2 wall} + $w create line 396 188 408 188 -fill $color -tags {floor2 wall} + $w create line 727 189 725 189 -fill $color -tags {floor2 wall} + $w create line 747 167 802 167 -fill $color -tags {floor2 wall} + $w create line 747 167 747 189 -fill $color -tags {floor2 wall} + $w create line 755 189 739 189 -fill $color -tags {floor2 wall} + $w create line 769 224 757 224 -fill $color -tags {floor2 wall} + $w create line 802 224 802 129 -fill $color -tags {floor2 wall} + $w create line 802 129 725 129 -fill $color -tags {floor2 wall} + $w create line 725 189 725 129 -fill $color -tags {floor2 wall} + $w create line 725 186 690 186 -fill $color -tags {floor2 wall} + $w create line 676 133 676 186 -fill $color -tags {floor2 wall} + $w create line 627 144 627 186 -fill $color -tags {floor2 wall} + $w create line 629 186 593 186 -fill $color -tags {floor2 wall} + $w create line 579 144 579 186 -fill $color -tags {floor2 wall} + $w create line 559 129 559 133 -fill $color -tags {floor2 wall} + $w create line 725 133 559 133 -fill $color -tags {floor2 wall} + $w create line 484 162 484 129 -fill $color -tags {floor2 wall} + $w create line 559 129 484 129 -fill $color -tags {floor2 wall} + $w create line 526 129 526 186 -fill $color -tags {floor2 wall} + $w create line 540 186 581 186 -fill $color -tags {floor2 wall} + $w create line 528 186 523 186 -fill $color -tags {floor2 wall} + $w create line 511 186 475 186 -fill $color -tags {floor2 wall} + $w create line 496 190 496 186 -fill $color -tags {floor2 wall} + $w create line 496 205 496 202 -fill $color -tags {floor2 wall} + $w create line 475 205 527 205 -fill $color -tags {floor2 wall} + $w create line 558 205 539 205 -fill $color -tags {floor2 wall} + $w create line 558 205 558 249 -fill $color -tags {floor2 wall} + $w create line 558 249 475 249 -fill $color -tags {floor2 wall} + $w create line 662 206 642 206 -fill $color -tags {floor2 wall} + $w create line 695 206 675 206 -fill $color -tags {floor2 wall} + $w create line 695 278 642 278 -fill $color -tags {floor2 wall} + $w create line 642 291 642 206 -fill $color -tags {floor2 wall} + $w create line 695 291 695 206 -fill $color -tags {floor2 wall} + $w create line 716 208 716 206 -fill $color -tags {floor2 wall} + $w create line 757 206 716 206 -fill $color -tags {floor2 wall} + $w create line 757 221 757 224 -fill $color -tags {floor2 wall} + $w create line 793 224 802 224 -fill $color -tags {floor2 wall} + $w create line 757 262 716 262 -fill $color -tags {floor2 wall} + $w create line 716 220 716 264 -fill $color -tags {floor2 wall} + $w create line 716 315 716 276 -fill $color -tags {floor2 wall} + $w create line 757 315 703 315 -fill $color -tags {floor2 wall} + $w create line 757 325 757 224 -fill $color -tags {floor2 wall} + $w create line 757 367 644 367 -fill $color -tags {floor2 wall} + $w create line 689 367 689 315 -fill $color -tags {floor2 wall} + $w create line 647 315 644 315 -fill $color -tags {floor2 wall} + $w create line 659 315 691 315 -fill $color -tags {floor2 wall} + $w create line 600 325 600 391 -fill $color -tags {floor2 wall} + $w create line 627 325 644 325 -fill $color -tags {floor2 wall} + $w create line 644 391 644 315 -fill $color -tags {floor2 wall} + $w create line 615 325 575 325 -fill $color -tags {floor2 wall} + $w create line 644 391 558 391 -fill $color -tags {floor2 wall} + $w create line 563 325 558 325 -fill $color -tags {floor2 wall} + $w create line 558 391 558 314 -fill $color -tags {floor2 wall} + $w create line 558 327 508 327 -fill $color -tags {floor2 wall} + $w create line 558 275 484 275 -fill $color -tags {floor2 wall} + $w create line 558 302 558 275 -fill $color -tags {floor2 wall} + $w create line 508 327 508 311 -fill $color -tags {floor2 wall} + $w create line 484 311 508 311 -fill $color -tags {floor2 wall} + $w create line 484 275 484 311 -fill $color -tags {floor2 wall} + $w create line 475 208 408 208 -fill $color -tags {floor2 wall} + $w create line 408 206 408 210 -fill $color -tags {floor2 wall} + $w create line 408 222 408 227 -fill $color -tags {floor2 wall} + $w create line 408 227 398 227 -fill $color -tags {floor2 wall} + $w create line 398 227 398 254 -fill $color -tags {floor2 wall} + $w create line 408 188 408 194 -fill $color -tags {floor2 wall} + $w create line 383 188 376 188 -fill $color -tags {floor2 wall} + $w create line 398 188 398 162 -fill $color -tags {floor2 wall} + $w create line 398 162 484 162 -fill $color -tags {floor2 wall} + $w create line 475 162 475 254 -fill $color -tags {floor2 wall} + $w create line 398 254 475 254 -fill $color -tags {floor2 wall} + $w create line 484 280 395 280 -fill $color -tags {floor2 wall} + $w create line 395 311 395 275 -fill $color -tags {floor2 wall} + $w create line 307 197 293 197 -fill $color -tags {floor2 wall} + $w create line 278 197 233 197 -fill $color -tags {floor2 wall} + $w create line 233 197 233 249 -fill $color -tags {floor2 wall} + $w create line 307 179 284 179 -fill $color -tags {floor2 wall} + $w create line 233 249 278 249 -fill $color -tags {floor2 wall} + $w create line 269 179 269 133 -fill $color -tags {floor2 wall} + $w create line 220 179 220 133 -fill $color -tags {floor2 wall} + $w create line 155 191 110 191 -fill $color -tags {floor2 wall} + $w create line 90 190 98 190 -fill $color -tags {floor2 wall} + $w create line 98 169 98 190 -fill $color -tags {floor2 wall} + $w create line 52 133 52 165 -fill $color -tags {floor2 wall} + $w create line 52 214 52 177 -fill $color -tags {floor2 wall} + $w create line 52 226 52 262 -fill $color -tags {floor2 wall} + $w create line 52 274 52 276 -fill $color -tags {floor2 wall} + $w create line 234 275 234 339 -fill $color -tags {floor2 wall} + $w create line 226 339 258 339 -fill $color -tags {floor2 wall} + $w create line 211 387 211 339 -fill $color -tags {floor2 wall} + $w create line 214 339 177 339 -fill $color -tags {floor2 wall} + $w create line 258 387 60 387 -fill $color -tags {floor2 wall} + $w create line 3 133 3 339 -fill $color -tags {floor2 wall} + $w create line 165 339 129 339 -fill $color -tags {floor2 wall} + $w create line 117 339 80 339 -fill $color -tags {floor2 wall} + $w create line 68 339 59 339 -fill $color -tags {floor2 wall} + $w create line 0 339 46 339 -fill $color -tags {floor2 wall} + $w create line 60 391 0 391 -fill $color -tags {floor2 wall} + $w create line 0 339 0 391 -fill $color -tags {floor2 wall} + $w create line 60 387 60 391 -fill $color -tags {floor2 wall} + $w create line 258 329 258 387 -fill $color -tags {floor2 wall} + $w create line 350 329 258 329 -fill $color -tags {floor2 wall} + $w create line 395 311 350 311 -fill $color -tags {floor2 wall} + $w create line 398 129 315 129 -fill $color -tags {floor2 wall} + $w create line 176 133 315 133 -fill $color -tags {floor2 wall} + $w create line 176 129 96 129 -fill $color -tags {floor2 wall} + $w create line 3 133 96 133 -fill $color -tags {floor2 wall} + $w create line 66 387 66 339 -fill $color -tags {floor2 wall} + $w create line 115 387 115 339 -fill $color -tags {floor2 wall} + $w create line 163 387 163 339 -fill $color -tags {floor2 wall} + $w create line 234 275 276 275 -fill $color -tags {floor2 wall} + $w create line 288 275 309 275 -fill $color -tags {floor2 wall} + $w create line 298 275 298 329 -fill $color -tags {floor2 wall} + $w create line 341 283 350 283 -fill $color -tags {floor2 wall} + $w create line 321 275 341 275 -fill $color -tags {floor2 wall} + $w create line 375 275 395 275 -fill $color -tags {floor2 wall} + $w create line 315 129 315 170 -fill $color -tags {floor2 wall} + $w create line 376 170 307 170 -fill $color -tags {floor2 wall} + $w create line 307 250 307 170 -fill $color -tags {floor2 wall} + $w create line 376 245 376 170 -fill $color -tags {floor2 wall} + $w create line 340 241 307 241 -fill $color -tags {floor2 wall} + $w create line 340 245 340 224 -fill $color -tags {floor2 wall} + $w create line 340 210 340 201 -fill $color -tags {floor2 wall} + $w create line 340 187 340 170 -fill $color -tags {floor2 wall} + $w create line 340 206 307 206 -fill $color -tags {floor2 wall} + $w create line 293 250 307 250 -fill $color -tags {floor2 wall} + $w create line 271 179 238 179 -fill $color -tags {floor2 wall} + $w create line 226 179 195 179 -fill $color -tags {floor2 wall} + $w create line 176 129 176 179 -fill $color -tags {floor2 wall} + $w create line 182 179 176 179 -fill $color -tags {floor2 wall} + $w create line 174 169 176 169 -fill $color -tags {floor2 wall} + $w create line 162 169 90 169 -fill $color -tags {floor2 wall} + $w create line 96 169 96 129 -fill $color -tags {floor2 wall} + $w create line 175 227 90 227 -fill $color -tags {floor2 wall} + $w create line 90 190 90 227 -fill $color -tags {floor2 wall} + $w create line 52 179 3 179 -fill $color -tags {floor2 wall} + $w create line 52 228 3 228 -fill $color -tags {floor2 wall} + $w create line 52 276 3 276 -fill $color -tags {floor2 wall} + $w create line 155 177 155 169 -fill $color -tags {floor2 wall} + $w create line 110 191 110 169 -fill $color -tags {floor2 wall} + $w create line 155 189 155 197 -fill $color -tags {floor2 wall} + $w create line 350 283 350 329 -fill $color -tags {floor2 wall} + $w create line 162 197 155 197 -fill $color -tags {floor2 wall} + $w create line 341 275 341 283 -fill $color -tags {floor2 wall} + } + + # fg3 -- + # This procedure represents part of the floorplan database. When + # invoked, it instantiates the foreground information for the third + # floor (office outlines and numbers). + # + # Arguments: + # w - The canvas window. + # color - Color to use for drawing foreground information. + + proc fg3 {w color} { + global floorLabels floorItems + set i [$w create polygon 89 228 89 180 70 180 70 228 -fill {} -tags {floor3 room}] + set floorLabels($i) 316 + set {floorItems(316)} $i + $w create text 79.5 204 -text 316 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 115 368 162 368 162 323 115 323 -fill {} -tags {floor3 room}] + set floorLabels($i) 309 + set {floorItems(309)} $i + $w create text 138.5 345.5 -text 309 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 164 323 164 368 211 368 211 323 -fill {} -tags {floor3 room}] + set floorLabels($i) 308 + set {floorItems(308)} $i + $w create text 187.5 345.5 -text 308 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 256 368 212 368 212 323 256 323 -fill {} -tags {floor3 room}] + set floorLabels($i) 307 + set {floorItems(307)} $i + $w create text 234 345.5 -text 307 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 244 276 297 276 297 327 260 327 260 321 244 321 -fill {} -tags {floor3 room}] + set floorLabels($i) 305 + set {floorItems(305)} $i + $w create text 270.5 301.5 -text 305 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 251 219 251 203 244 203 244 219 -fill {} -tags {floor3 room}] + set floorLabels($i) 324B + set {floorItems(324B)} $i + $w create text 247.5 211 -text 324B -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 251 249 244 249 244 232 251 232 -fill {} -tags {floor3 room}] + set floorLabels($i) 324A + set {floorItems(324A)} $i + $w create text 247.5 240.5 -text 324A -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 223 135 223 179 177 179 177 135 -fill {} -tags {floor3 room}] + set floorLabels($i) 320 + set {floorItems(320)} $i + $w create text 200 157 -text 320 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 114 368 114 323 67 323 67 368 -fill {} -tags {floor3 room}] + set floorLabels($i) 310 + set {floorItems(310)} $i + $w create text 90.5 345.5 -text 310 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 23 277 23 321 68 321 68 277 -fill {} -tags {floor3 room}] + set floorLabels($i) 312 + set {floorItems(312)} $i + $w create text 45.5 299 -text 312 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 23 229 68 229 68 275 23 275 -fill {} -tags {floor3 room}] + set floorLabels($i) 313 + set {floorItems(313)} $i + $w create text 45.5 252 -text 313 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 68 227 23 227 23 180 68 180 -fill {} -tags {floor3 room}] + set floorLabels($i) 314 + set {floorItems(314)} $i + $w create text 45.5 203.5 -text 314 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 95 179 95 135 23 135 23 179 -fill {} -tags {floor3 room}] + set floorLabels($i) 315 + set {floorItems(315)} $i + $w create text 59 157 -text 315 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 99 226 99 204 91 204 91 226 -fill {} -tags {floor3 room}] + set floorLabels($i) 316B + set {floorItems(316B)} $i + $w create text 95 215 -text 316B -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 91 202 99 202 99 180 91 180 -fill {} -tags {floor3 room}] + set floorLabels($i) 316A + set {floorItems(316A)} $i + $w create text 95 191 -text 316A -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 97 169 109 169 109 192 154 192 154 198 174 198 174 226 101 226 101 179 97 179 -fill {} -tags {floor3 room}] + set floorLabels($i) 319 + set {floorItems(319)} $i + $w create text 141.5 209 -text 319 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 65 368 58 368 58 389 1 389 1 333 23 333 23 323 65 323 -fill {} -tags {floor3 room}] + set floorLabels($i) 311 + set {floorItems(311)} $i + $w create text 29.5 361 -text 311 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 154 191 111 191 111 169 154 169 -fill {} -tags {floor3 room}] + set floorLabels($i) 318 + set {floorItems(318)} $i + $w create text 132.5 180 -text 318 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 175 168 97 168 97 131 175 131 -fill {} -tags {floor3 room}] + set floorLabels($i) 317 + set {floorItems(317)} $i + $w create text 136 149.5 -text 317 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 274 194 274 221 306 221 306 194 -fill {} -tags {floor3 room}] + set floorLabels($i) 323 + set {floorItems(323)} $i + $w create text 290 207.5 -text 323 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 306 222 274 222 274 249 306 249 -fill {} -tags {floor3 room}] + set floorLabels($i) 325 + set {floorItems(325)} $i + $w create text 290 235.5 -text 325 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 263 179 224 179 224 135 263 135 -fill {} -tags {floor3 room}] + set floorLabels($i) 321 + set {floorItems(321)} $i + $w create text 243.5 157 -text 321 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 314 169 306 169 306 192 273 192 264 181 264 135 314 135 -fill {} -tags {floor3 room}] + set floorLabels($i) 322 + set {floorItems(322)} $i + $w create text 293.5 163.5 -text 322 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 307 240 339 240 339 206 307 206 -fill {} -tags {floor3 room}] + set floorLabels($i) {Pub Lift3} + set {floorItems(Pub Lift3)} $i + $w create text 323 223 -text {Pub Lift3} -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 339 205 307 205 307 171 339 171 -fill {} -tags {floor3 room}] + set floorLabels($i) {Priv Lift3} + set {floorItems(Priv Lift3)} $i + $w create text 323 188 -text {Priv Lift3} -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 350 284 376 284 376 276 397 276 397 309 350 309 -fill {} -tags {floor3 room}] + set floorLabels($i) 303 + set {floorItems(303)} $i + $w create text 373.5 292.5 -text 303 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 272 203 272 249 252 249 252 230 244 230 244 221 252 221 252 203 -fill {} -tags {floor3 room}] + set floorLabels($i) 324 + set {floorItems(324)} $i + $w create text 262 226 -text 324 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 299 276 299 327 349 327 349 284 341 284 341 276 -fill {} -tags {floor3 room}] + set floorLabels($i) 304 + set {floorItems(304)} $i + $w create text 324 301.5 -text 304 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 375 246 375 172 341 172 341 246 -fill {} -tags {floor3 room}] + set floorLabels($i) 301 + set {floorItems(301)} $i + $w create text 358 209 -text 301 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 397 246 377 246 377 185 397 185 -fill {} -tags {floor3 room}] + set floorLabels($i) 327 + set {floorItems(327)} $i + $w create text 387 215.5 -text 327 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 316 131 316 169 377 169 377 185 397 185 397 131 -fill {} -tags {floor3 room}] + set floorLabels($i) 326 + set {floorItems(326)} $i + $w create text 356.5 150 -text 326 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 308 251 242 251 242 274 342 274 342 282 375 282 375 274 397 274 397 248 339 248 339 242 308 242 -fill {} -tags {floor3 room}] + set floorLabels($i) 302 + set {floorItems(302)} $i + $w create text 319.5 261 -text 302 -fill $color -anchor c -tags {floor3 label} + set i [$w create polygon 70 321 242 321 242 200 259 200 259 203 272 203 272 193 263 180 242 180 175 180 175 169 156 169 156 196 177 196 177 228 107 228 70 228 70 275 107 275 107 248 160 248 160 301 107 301 107 275 70 275 -fill {} -tags {floor3 room}] + set floorLabels($i) 306 + set {floorItems(306)} $i + $w create text 200.5 284.5 -text 306 -fill $color -anchor c -tags {floor3 label} + $w create line 341 275 341 283 -fill $color -tags {floor3 wall} + $w create line 162 197 155 197 -fill $color -tags {floor3 wall} + $w create line 396 247 399 247 -fill $color -tags {floor3 wall} + $w create line 399 129 399 311 -fill $color -tags {floor3 wall} + $w create line 258 202 243 202 -fill $color -tags {floor3 wall} + $w create line 350 283 350 329 -fill $color -tags {floor3 wall} + $w create line 251 231 243 231 -fill $color -tags {floor3 wall} + $w create line 243 220 251 220 -fill $color -tags {floor3 wall} + $w create line 243 250 243 202 -fill $color -tags {floor3 wall} + $w create line 155 197 155 190 -fill $color -tags {floor3 wall} + $w create line 110 192 110 169 -fill $color -tags {floor3 wall} + $w create line 155 192 110 192 -fill $color -tags {floor3 wall} + $w create line 155 177 155 169 -fill $color -tags {floor3 wall} + $w create line 176 197 176 227 -fill $color -tags {floor3 wall} + $w create line 69 280 69 274 -fill $color -tags {floor3 wall} + $w create line 21 276 69 276 -fill $color -tags {floor3 wall} + $w create line 69 262 69 226 -fill $color -tags {floor3 wall} + $w create line 21 228 69 228 -fill $color -tags {floor3 wall} + $w create line 21 179 75 179 -fill $color -tags {floor3 wall} + $w create line 69 179 69 214 -fill $color -tags {floor3 wall} + $w create line 90 220 90 227 -fill $color -tags {floor3 wall} + $w create line 90 204 90 202 -fill $color -tags {floor3 wall} + $w create line 90 203 100 203 -fill $color -tags {floor3 wall} + $w create line 90 187 90 179 -fill $color -tags {floor3 wall} + $w create line 90 227 176 227 -fill $color -tags {floor3 wall} + $w create line 100 179 100 227 -fill $color -tags {floor3 wall} + $w create line 100 179 87 179 -fill $color -tags {floor3 wall} + $w create line 96 179 96 129 -fill $color -tags {floor3 wall} + $w create line 162 169 96 169 -fill $color -tags {floor3 wall} + $w create line 173 169 176 169 -fill $color -tags {floor3 wall} + $w create line 182 179 176 179 -fill $color -tags {floor3 wall} + $w create line 176 129 176 179 -fill $color -tags {floor3 wall} + $w create line 195 179 226 179 -fill $color -tags {floor3 wall} + $w create line 224 133 224 179 -fill $color -tags {floor3 wall} + $w create line 264 179 264 133 -fill $color -tags {floor3 wall} + $w create line 238 179 264 179 -fill $color -tags {floor3 wall} + $w create line 273 207 273 193 -fill $color -tags {floor3 wall} + $w create line 273 235 273 250 -fill $color -tags {floor3 wall} + $w create line 273 224 273 219 -fill $color -tags {floor3 wall} + $w create line 273 193 307 193 -fill $color -tags {floor3 wall} + $w create line 273 222 307 222 -fill $color -tags {floor3 wall} + $w create line 273 250 307 250 -fill $color -tags {floor3 wall} + $w create line 384 247 376 247 -fill $color -tags {floor3 wall} + $w create line 340 206 307 206 -fill $color -tags {floor3 wall} + $w create line 340 187 340 170 -fill $color -tags {floor3 wall} + $w create line 340 210 340 201 -fill $color -tags {floor3 wall} + $w create line 340 247 340 224 -fill $color -tags {floor3 wall} + $w create line 340 241 307 241 -fill $color -tags {floor3 wall} + $w create line 376 247 376 170 -fill $color -tags {floor3 wall} + $w create line 307 250 307 170 -fill $color -tags {floor3 wall} + $w create line 376 170 307 170 -fill $color -tags {floor3 wall} + $w create line 315 129 315 170 -fill $color -tags {floor3 wall} + $w create line 376 283 366 283 -fill $color -tags {floor3 wall} + $w create line 376 283 376 275 -fill $color -tags {floor3 wall} + $w create line 399 275 376 275 -fill $color -tags {floor3 wall} + $w create line 341 275 320 275 -fill $color -tags {floor3 wall} + $w create line 341 283 350 283 -fill $color -tags {floor3 wall} + $w create line 298 275 298 329 -fill $color -tags {floor3 wall} + $w create line 308 275 298 275 -fill $color -tags {floor3 wall} + $w create line 243 322 243 275 -fill $color -tags {floor3 wall} + $w create line 243 275 284 275 -fill $color -tags {floor3 wall} + $w create line 258 322 226 322 -fill $color -tags {floor3 wall} + $w create line 212 370 212 322 -fill $color -tags {floor3 wall} + $w create line 214 322 177 322 -fill $color -tags {floor3 wall} + $w create line 163 370 163 322 -fill $color -tags {floor3 wall} + $w create line 165 322 129 322 -fill $color -tags {floor3 wall} + $w create line 84 322 117 322 -fill $color -tags {floor3 wall} + $w create line 71 322 64 322 -fill $color -tags {floor3 wall} + $w create line 115 322 115 370 -fill $color -tags {floor3 wall} + $w create line 66 322 66 370 -fill $color -tags {floor3 wall} + $w create line 52 322 21 322 -fill $color -tags {floor3 wall} + $w create line 21 331 0 331 -fill $color -tags {floor3 wall} + $w create line 21 331 21 133 -fill $color -tags {floor3 wall} + $w create line 96 133 21 133 -fill $color -tags {floor3 wall} + $w create line 176 129 96 129 -fill $color -tags {floor3 wall} + $w create line 315 133 176 133 -fill $color -tags {floor3 wall} + $w create line 315 129 399 129 -fill $color -tags {floor3 wall} + $w create line 399 311 350 311 -fill $color -tags {floor3 wall} + $w create line 350 329 258 329 -fill $color -tags {floor3 wall} + $w create line 258 322 258 370 -fill $color -tags {floor3 wall} + $w create line 60 370 258 370 -fill $color -tags {floor3 wall} + $w create line 60 370 60 391 -fill $color -tags {floor3 wall} + $w create line 0 391 0 331 -fill $color -tags {floor3 wall} + $w create line 60 391 0 391 -fill $color -tags {floor3 wall} + $w create line 307 250 307 242 -fill $color -tags {floor3 wall} + $w create line 273 250 307 250 -fill $color -tags {floor3 wall} + $w create line 258 250 243 250 -fill $color -tags {floor3 wall} + } + + # Below is the "main program" that creates the floorplan demonstration. + + set w .floor + global c tk_library currentRoom colors activeFloor + catch {destroy $w} + toplevel $w + wm title $w "Floorplan Canvas Demonstration" + wm iconname $w "Floorplan" + wm geometry $w +20+20 + wm minsize $w 100 100 + + label $w.msg -font $font -wraplength 8i -justify left -text "このウィンドウにはディジタルエクイップメント社のウェスタンリサーチラボラトリ (DECWRL) の間取りが書かれたキャンバス widget が入っています。これは 3階建てで、常にそのうちの1階分が選択、つまりその間取りが表示されるようになっています。ある階を選択するには、その上でマウスの左ボタンをクリックしてください。マウスが選択されている階の上を動くと、その下にある部屋の色が変わり、部屋番号が「部屋番号:」エントリに表示されます。また、エントリに部屋番号を書くとその部屋の色が変わります。" + pack $w.msg -side top + + frame $w.buttons + pack $w.buttons -side bottom -fill x -pady 2m + button $w.buttons.dismiss -text 了解 -command "destroy $w" + button $w.buttons.code -text コード参照 -command "showCode $w" + pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 + + set f [frame $w.frame] + pack $f -side top -fill both -expand yes + set h [scrollbar $f.hscroll -highlightthickness 0 -orient horizontal] + set v [scrollbar $f.vscroll -highlightthickness 0 -orient vertical] + set f1 [frame $f.f1 -bd 2 -relief sunken] + set c [canvas $f1.c -width 900 -height 500 -borderwidth 0 \ + -highlightthickness 0 -xscrollcommand "$h set" -yscrollcommand "$v set"] + pack $c -expand yes -fill both + grid $f1 -padx 1 -pady 1 \ + -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news + grid $v -padx 1 -pady 1 \ + -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news + grid $h -padx 1 -pady 1 \ + -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news + grid rowconfig $f 0 -weight 1 -minsize 0 + grid columnconfig $f 0 -weight 1 -minsize 0 + pack $f -expand yes -fill both -padx 1 -pady 1 + + $v config -command "$c yview" + $h config -command "$c xview" + + # Create an entry for displaying and typing in current room. + + entry $c.entry -width 10 -relief sunken -bd 2 -textvariable currentRoom + + # Choose colors, then fill in the floorplan. + + if {[winfo depth $c] > 1} { + set colors(bg1) #a9c1da + set colors(outline1) #77889a + set colors(bg2) #9ab0c6 + set colors(outline2) #687786 + set colors(bg3) #8ba0b3 + set colors(outline3) #596673 + set colors(offices) Black + set colors(active) #c4d1df + } else { + set colors(bg1) white + set colors(outline1) black + set colors(bg2) white + set colors(outline2) black + set colors(bg3) white + set colors(outline3) black + set colors(offices) Black + set colors(active) black + } + set activeFloor "" + floorDisplay $c 3 + + # Set up event bindings for canvas: + + $c bind floor1 <1> "floorDisplay $c 1" + $c bind floor2 <1> "floorDisplay $c 2" + $c bind floor3 <1> "floorDisplay $c 3" + $c bind room "newRoom $c" + $c bind room {set currentRoom ""} + bind $c <2> "$c scan mark %x %y" + bind $c "$c scan dragto %x %y" + bind $c "unset currentRoom" + set currentRoom "" + trace variable currentRoom w "roomChanged $c" diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/form.tcl ./library/demos.jp/form.tcl *** ../tk4.2/library/demos.jp/form.tcl Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/form.tcl Sun Nov 24 18:25:55 1996 *************** *** 0 **** --- 1,36 ---- + # form.tcl -- + # + # This demonstration script creates a simple form with a bunch + # of entry widgets. + # + # SCCS: @(#) form.tcl 1.4 96/02/16 10:49:30 + + set w .form + catch {destroy $w} + toplevel $w + wm title $w "Form Demonstration" + wm iconname $w "form" + positionWindow $w + + label $w.msg -font $font -wraplength 4i -justify left -text "このウィンドウは簡単なフォーム入力用になっていて、さまざまなエントリに入力ができます。タブでエントリの切替えができます。" + pack $w.msg -side top + + frame $w.buttons + pack $w.buttons -side bottom -fill x -pady 2m + button $w.buttons.dismiss -text 了解 -command "destroy $w" + button $w.buttons.code -text "コード参照" -command "showCode $w" + pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 + + foreach i {f1 f2 f3 f4 f5} { + frame $w.$i -bd 2 + entry $w.$i.entry -relief sunken -width 40 + label $w.$i.label + pack $w.$i.entry -side right + pack $w.$i.label -side left + } + $w.f1.label config -text 名前: + $w.f2.label config -text 住所: + $w.f5.label config -text 電話: + pack $w.msg $w.f1 $w.f2 $w.f3 $w.f4 $w.f5 -side top -fill x + bind $w "destroy $w" + focus $w.f1.entry diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/hello ./library/demos.jp/hello *** ../tk4.2/library/demos.jp/hello Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/hello Sun Nov 24 18:25:55 1996 *************** *** 0 **** --- 1,18 ---- + #!/bin/sh + # the next line restarts using wish \ + exec wish "$0" "$@" + + # hello -- + # Simple Tk script to create a button that prints "Hello, world". + # Click on the button to terminate the program. + # + # SCCS: @(#) hello 1.6 96/02/16 10:49:18 + # + # The first line below creates the button, and the second line + # asks the packer to shrink-wrap the application's main window + # around the button. + + button .hello -text "こんにちは、世界" -command { + puts stdout "こんにちは、世界"; destroy . + } + pack .hello diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/hscale.tcl ./library/demos.jp/hscale.tcl *** ../tk4.2/library/demos.jp/hscale.tcl Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/hscale.tcl Sun Nov 24 18:25:55 1996 *************** *** 0 **** --- 1,43 ---- + # hscale.tcl -- + # + # This demonstration script shows an example with a horizontal scale. + # + # SCCS: @(#) hscale.tcl 1.3 96/02/16 10:49:47 + + set w .hscale + catch {destroy $w} + toplevel $w + wm title $w "Horizontal Scale Demonstration" + wm iconname $w "hscale" + positionWindow $w + + label $w.msg -font $font -wraplength 3.5i -justify left -text "下にはバーと横型のスケールが表示されています。スケールでマウスのボタン1 をクリックするかドラッグしてバーの幅を変えることができます。終ったら「了解」ボタンを押してください。" + pack $w.msg -side top -padx .5c + + frame $w.buttons + pack $w.buttons -side bottom -fill x -pady 2m + button $w.buttons.dismiss -text 了解 -command "destroy $w" + button $w.buttons.code -text "コード参照" -command "showCode $w" + pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 + + frame $w.frame -borderwidth 10 + pack $w.frame -side top -fill x + + canvas $w.frame.canvas -width 50 -height 50 -bd 0 -highlightthickness 0 + $w.frame.canvas create polygon 0 0 1 1 2 2 -fill DeepSkyBlue3 -tags poly + $w.frame.canvas create line 0 0 1 1 2 2 0 0 -fill black -tags line + scale $w.frame.scale -orient horizontal -length 284 -from 0 -to 250 \ + -command "setWidth $w.frame.canvas" -tickinterval 50 + pack $w.frame.canvas -side top -expand yes -anchor s -fill x -padx 15 + pack $w.frame.scale -side bottom -expand yes -anchor n + $w.frame.scale set 75 + + proc setWidth {w width} { + incr width 21 + set x2 [expr $width - 30] + if {$x2 < 21} { + set x2 21 + } + $w coords poly 20 15 20 35 $x2 35 $x2 45 $width 25 $x2 5 $x2 15 20 15 + $w coords line 20 15 20 35 $x2 35 $x2 45 $width 25 $x2 5 $x2 15 20 15 + } diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/icon.tcl ./library/demos.jp/icon.tcl *** ../tk4.2/library/demos.jp/icon.tcl Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/icon.tcl Sun Nov 24 18:25:55 1996 *************** *** 0 **** --- 1,48 ---- + # icon.tcl -- + # + # This demonstration script creates a toplevel window containing + # buttons that display bitmaps instead of text. + # + # SCCS: @(#) icon.tcl 1.7 96/04/12 11:54:38 + + set w .icon + catch {destroy $w} + toplevel $w + wm title $w "Iconic Button Demonstration" + wm iconname $w "icon" + positionWindow $w + + label $w.msg -font $font -wraplength 5i -justify left -text "このウィンドウにはラジオボタンとチェックボタン上にビットマップや画像を表示する 3 つの方法を示しています。左にあるのは2つのラジオボタンで、それぞれが、ビットマップと選択を示すインジケータでできています。中央にあるのは、選択済みかどうかによって異なる画像を表示するチェックボタンです。右側にあるのは選択済みかどうかによって背景色が変わるビットマップを表示するチェックボタンです。" + pack $w.msg -side top + + frame $w.buttons + pack $w.buttons -side bottom -fill x -pady 2m + button $w.buttons.dismiss -text 了解 -command "destroy $w" + button $w.buttons.code -text "コード参照" -command "showCode $w" + pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 + + image create bitmap flagup \ + -file [file join $tk_library demos images flagup.bmp] \ + -maskfile [file join $tk_library demos images flagup.bmp] + image create bitmap flagdown \ + -file [file join $tk_library demos images flagdown.bmp] \ + -maskfile [file join $tk_library demos images flagdown.bmp] + frame $w.frame -borderwidth 10 + pack $w.frame -side top + + checkbutton $w.frame.b1 -image flagdown -selectimage flagup \ + -indicatoron 0 + $w.frame.b1 configure -selectcolor [$w.frame.b1 cget -background] + checkbutton $w.frame.b2 \ + -bitmap @[file join $tk_library demos images letters.bmp] \ + -indicatoron 0 -selectcolor SeaGreen1 + frame $w.frame.left + pack $w.frame.left $w.frame.b1 $w.frame.b2 -side left -expand yes -padx 5m + + radiobutton $w.frame.left.b3 \ + -bitmap @[file join $tk_library demos images letters.bmp] \ + -variable letters -value full + radiobutton $w.frame.left.b4 \ + -bitmap @[file join $tk_library demos images noletter.bmp] \ + -variable letters -value empty + pack $w.frame.left.b3 $w.frame.left.b4 -side top -expand yes diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/image1.tcl ./library/demos.jp/image1.tcl *** ../tk4.2/library/demos.jp/image1.tcl Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/image1.tcl Sun Nov 24 18:25:55 1996 *************** *** 0 **** --- 1,32 ---- + # image1.tcl -- + # + # This demonstration script displays two image widgets. + # + # SCCS: @(#) image1.tcl 1.5 96/08/20 15:50:44 + + set w .image1 + catch {destroy $w} + toplevel $w + wm title $w "Image Demonstration #1" + wm iconname $w "Image1" + positionWindow $w + + label $w.msg -font $font -wraplength 4i -justify left -text "このデモでは 2 つのラベル上に画像をそれぞれ表示しています。" + pack $w.msg -side top + + frame $w.buttons + pack $w.buttons -side bottom -fill x -pady 2m + button $w.buttons.dismiss -text 了解 -command "destroy $w" + button $w.buttons.code -text "コード参照" -command "showCode $w" + pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 + + catch {image delete image1a} + image create photo image1a -file [file join $tk_library demos images earth.gif] + label $w.l1 -image image1a -bd 1 -relief sunken + + catch {image delete image1b} + image create photo image1b \ + -file [file join $tk_library demos images earthris.gif] + label $w.l2 -image image1b -bd 1 -relief sunken + + pack $w.l1 $w.l2 -side top -padx .5m -pady .5m diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/image2.tcl ./library/demos.jp/image2.tcl *** ../tk4.2/library/demos.jp/image2.tcl Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/image2.tcl Sun Nov 24 18:25:55 1996 *************** *** 0 **** --- 1,76 ---- + # image2.tcl -- + # + # This demonstration script creates a simple collection of widgets + # that allow you to select and view images in a Tk label. + # + # SCCS: @(#) image2.tcl 1.8 96/08/20 16:53:29 + + # loadDir -- + # This procedure reloads the directory listbox from the directory + # named in the demo's entry. + # + # Arguments: + # w - Name of the toplevel window of the demo. + + proc loadDir w { + global dirName + + $w.f.list delete 0 end + foreach i [lsort [glob [file join $dirName *]]] { + $w.f.list insert end [file tail $i] + } + } + + # loadImage -- + # Given the name of the toplevel window of the demo and the mouse + # position, extracts the directory entry under the mouse and loads + # that file into a photo image for display. + # + # Arguments: + # w - Name of the toplevel window of the demo. + # x, y- Mouse position within the listbox. + + proc loadImage {w x y} { + global dirName + + set file [file join $dirName [$w.f.list get @$x,$y]] + image2a configure -file $file + } + + set w .image2 + catch {destroy $w} + toplevel $w + wm title $w "Image Demonstration #2" + wm iconname $w "Image2" + positionWindow $w + + label $w.msg -font $font -wraplength 4i -justify left -text "このデモでは Tk の photo image を使用して画像を見ることができます。最初にエントリ内ににディレクトリ名を入れて下さい。次に下のリストボックスにこのディレクトリをロードするため、リターンを押してください。その後、画像を選択するためにリストボックスの中のファイル名をダブルクリックして下さい。" + pack $w.msg -side top + + frame $w.buttons + pack $w.buttons -side bottom -fill x -pady 2m + button $w.buttons.dismiss -text 了解 -command "destroy $w" + button $w.buttons.code -text "コード参照" -command "showCode $w" + pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 + + label $w.dirLabel -text "ディレクトリ:" + set dirName [file join $tk_library demos images] + entry $w.dirName -width 30 -textvariable dirName + bind $w.dirName "loadDir $w" + frame $w.spacer1 -height 3m -width 20 + label $w.fileLabel -text "ファイル:" + frame $w.f + pack $w.dirLabel $w.dirName $w.spacer1 $w.fileLabel $w.f -side top -anchor w + + listbox $w.f.list -width 20 -height 10 -yscrollcommand "$w.f.scroll set" + scrollbar $w.f.scroll -command "$w.f.list yview" + pack $w.f.list $w.f.scroll -side left -fill y -expand 1 + $w.f.list insert 0 earth.gif earthris.gif teapot.ppm + bind $w.f.list "loadImage $w %x %y" + + catch {image delete image2a} + image create photo image2a + frame $w.spacer2 -height 3m -width 20 + label $w.imageLabel -text "画像:" + label $w.image -image image2a + pack $w.spacer2 $w.imageLabel $w.image -side top -anchor w diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/items.tcl ./library/demos.jp/items.tcl *** ../tk4.2/library/demos.jp/items.tcl Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/items.tcl Sun Nov 24 18:25:55 1996 *************** *** 0 **** --- 1,281 ---- + # items.tcl -- + # + # This demonstration script creates a canvas that displays the + # canvas item types. + # + # SCCS: @(#) items.tcl 1.14 96/10/04 17:09:35 + + set w .items + catch {destroy $w} + toplevel $w + wm title $w "Canvas Item Demonstration" + wm iconname $w "Items" + positionWindow $w + set c $w.frame.c + + label $w.msg -font $font -wraplength 5i -justify left -text "このウィンドウにはキャンバス widget が入っており、その中にはキャンバス widget がサポートする様々なタイプのアイテムの例が入っています。次のような操作ができます。\n ボタン-1 ドラッグ:\tアイテムを動かす。\n ボタン-2 ドラッグ:\t見えている部分をずらす。\n ボタン-3 ドラッグ:\t領域を囲う。\n コントロール-F:\t領域の下のアイテムを表示する。" + pack $w.msg -side top + + frame $w.buttons + pack $w.buttons -side bottom -fill x -pady 2m + button $w.buttons.dismiss -text 了解 -command "destroy $w" + button $w.buttons.code -text コード参照 -command "showCode $w" + pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 + + frame $w.frame + pack $w.frame -side top -fill both -expand yes + + canvas $c -scrollregion {0c 0c 30c 24c} -width 15c -height 10c \ + -relief sunken -borderwidth 2 \ + -xscrollcommand "$w.frame.hscroll set" \ + -yscrollcommand "$w.frame.vscroll set" + scrollbar $w.frame.vscroll -command "$c yview" + scrollbar $w.frame.hscroll -orient horiz -command "$c xview" + + grid $c -in $w.frame \ + -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news + grid $w.frame.vscroll \ + -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news + grid $w.frame.hscroll \ + -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news + grid rowconfig $w.frame 0 -weight 1 -minsize 0 + grid columnconfig $w.frame 0 -weight 1 -minsize 0 + + # Display a 3x3 rectangular grid. + + $c create rect 0c 0c 30c 24c -width 2 + $c create line 0c 8c 30c 8c -width 2 + $c create line 0c 16c 30c 16c -width 2 + $c create line 10c 0c 10c 24c -width 2 + $c create line 20c 0c 20c 24c -width 2 + + set font1 -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* + set font2 -Adobe-Helvetica-Bold-R-Normal--*-240-*-*-*-*-*-* + if {[winfo depth $c] > 1} { + set blue DeepSkyBlue3 + set red red + set bisque bisque3 + set green SeaGreen3 + } else { + set blue black + set red black + set bisque black + set green black + } + + # Set up demos within each of the areas of the grid. + + $c create text 5c .2c -text ライン -anchor n + $c create line 1c 1c 3c 1c 1c 4c 3c 4c -width 2m -fill $blue \ + -cap butt -join miter -tags item + $c create line 4.67c 1c 4.67c 4c -arrow last -tags item + $c create line 6.33c 1c 6.33c 4c -arrow both -tags item + $c create line 5c 6c 9c 6c 9c 1c 8c 1c 8c 4.8c 8.8c 4.8c 8.8c 1.2c \ + 8.2c 1.2c 8.2c 4.6c 8.6c 4.6c 8.6c 1.4c 8.4c 1.4c 8.4c 4.4c \ + -width 3 -fill $red -tags item + $c create line 1c 5c 7c 5c 7c 7c 9c 7c -width .5c \ + -stipple @[file join $tk_library demos images gray25.bmp] \ + -arrow both -arrowshape {15 15 7} -tags item + $c create line 1c 7c 1.75c 5.8c 2.5c 7c 3.25c 5.8c 4c 7c -width .5c \ + -cap round -join round -tags item + + $c create text 15c .2c -text "曲線 (滑らかにつないだ直線)" -anchor n + $c create line 11c 4c 11.5c 1c 13.5c 1c 14c 4c -smooth on \ + -fill $blue -tags item + $c create line 15.5c 1c 19.5c 1.5c 15.5c 4.5c 19.5c 4c -smooth on \ + -arrow both -width 3 -tags item + $c create line 12c 6c 13.5c 4.5c 16.5c 7.5c 18c 6c \ + 16.5c 4.5c 13.5c 7.5c 12c 6c -smooth on -width 3m -cap round \ + -stipple @[file join $tk_library demos images gray25.bmp] \ + -fill $red -tags item + + $c create text 25c .2c -text 多角形 -anchor n + $c create polygon 21c 1.0c 22.5c 1.75c 24c 1.0c 23.25c 2.5c \ + 24c 4.0c 22.5c 3.25c 21c 4.0c 21.75c 2.5c -fill $green \ + -outline black -width 4 -tags item + $c create polygon 25c 4c 25c 4c 25c 1c 26c 1c 27c 4c 28c 1c \ + 29c 1c 29c 4c 29c 4c -fill $red -smooth on -tags item + $c create polygon 22c 4.5c 25c 4.5c 25c 6.75c 28c 6.75c \ + 28c 5.25c 24c 5.25c 24c 6.0c 26c 6c 26c 7.5c 22c 7.5c \ + -stipple @[file join $tk_library demos images gray25.bmp] \ + -outline black -tags item + + $c create text 5c 8.2c -text 矩形 -anchor n + $c create rectangle 1c 9.5c 4c 12.5c -outline $red -width 3m -tags item + $c create rectangle 0.5c 13.5c 4.5c 15.5c -fill $green -tags item + $c create rectangle 6c 10c 9c 15c -outline {} \ + -stipple @[file join $tk_library demos images gray25.bmp] \ + -fill $blue -tags item + + $c create text 15c 8.2c -text 楕円 -anchor n + $c create oval 11c 9.5c 14c 12.5c -outline $red -width 3m -tags item + $c create oval 10.5c 13.5c 14.5c 15.5c -fill $green -tags item + $c create oval 16c 10c 19c 15c -outline {} \ + -stipple @[file join $tk_library demos images gray25.bmp] \ + -fill $blue -tags item + + $c create text 25c 8.2c -text テキスト -anchor n + $c create rectangle 22.4c 8.9c 22.6c 9.1c + $c create text 22.5c 9c -anchor n -font $font1 -width 4c \ + -text "短いテキスト。ワードラップ、左揃え、アンカーは北 (上)。□は各テキストのアンカーポイントを示す。" -tags item + $c create rectangle 25.4c 10.9c 25.6c 11.1c + $c create text 25.5c 11c -anchor w -font $font1 -fill $blue \ + -text "いくつかの行。\nそれぞれ独立に\n行揃え。\n全て左端がアンカーされている。" \ + -justify center -tags item + $c create rectangle 24.9c 13.9c 25.1c 14.1c + $c create text 25c 14c -font $font2 -anchor c -fill $red -stipple gray50 \ + -text "Stippled characters" -tags item + + $c create text 5c 16.2c -text "弧" -anchor n + $c create arc 0.5c 17c 7c 20c -fill $green -outline black \ + -start 45 -extent 270 -style pieslice -tags item + $c create arc 6.5c 17c 9.5c 20c -width 4m -style arc \ + -outline $blue -start -135 -extent 270 -tags item \ + -outlinestipple @[file join $tk_library demos images gray25.bmp] + $c create arc 0.5c 20c 9.5c 24c -width 4m -style pieslice \ + -fill {} -outline $red -start 225 -extent -90 -tags item + $c create arc 5.5c 20.5c 9.5c 23.5c -width 4m -style chord \ + -fill $blue -outline {} -start 45 -extent 270 -tags item + + $c create text 15c 16.2c -text ビットマップ -anchor n + $c create bitmap 13c 20c -tags item \ + -bitmap @[file join $tk_library demos images face.bmp] + $c create bitmap 17c 18.5c -tags item \ + -bitmap @[file join $tk_library demos images noletter.bmp] + $c create bitmap 17c 21.5c -tags item \ + -bitmap @[file join $tk_library demos images letters.bmp] + + $c create text 25c 16.2c -text ウィンドウ -anchor n + button $c.button -text 押してね -command "butPress $c $red" + $c create window 21c 18c -window $c.button -anchor nw -tags item + entry $c.entry -width 20 -relief sunken + $c.entry insert end 編集してね + $c create window 21c 21c -window $c.entry -anchor nw -tags item + scale $c.scale -from 0 -to 100 -length 6c -sliderlength .4c \ + -width .5c -tickinterval 0 + $c create window 28.5c 17.5c -window $c.scale -anchor n -tags item + $c create text 21c 17.9c -text ボタン: -anchor sw + $c create text 21c 20.9c -text エントリ: -anchor sw + $c create text 28.5c 17.4c -text スケール: -anchor s + + # Set up event bindings for canvas: + + $c bind item "itemEnter $c" + $c bind item "itemLeave $c" + bind $c <2> "$c scan mark %x %y" + bind $c "$c scan dragto %x %y" + bind $c <3> "itemMark $c %x %y" + bind $c "itemStroke $c %x %y" + bind $c "itemsUnderArea $c" + bind $c <1> "itemStartDrag $c %x %y" + bind $c "itemDrag $c %x %y" + + # Utility procedures for highlighting the item under the pointer: + + proc itemEnter {c} { + global restoreCmd + + if {[winfo depth $c] == 1} { + set restoreCmd {} + return + } + set type [$c type current] + if {$type == "window"} { + set restoreCmd {} + return + } + if {$type == "bitmap"} { + set bg [lindex [$c itemconf current -background] 4] + set restoreCmd [list $c itemconfig current -background $bg] + $c itemconfig current -background SteelBlue2 + return + } + set fill [lindex [$c itemconfig current -fill] 4] + if {(($type == "rectangle") || ($type == "oval") || ($type == "arc")) + && ($fill == "")} { + set outline [lindex [$c itemconfig current -outline] 4] + set restoreCmd "$c itemconfig current -outline $outline" + $c itemconfig current -outline SteelBlue2 + } else { + set restoreCmd "$c itemconfig current -fill $fill" + $c itemconfig current -fill SteelBlue2 + } + } + + proc itemLeave {c} { + global restoreCmd + + eval $restoreCmd + } + + # Utility procedures for stroking out a rectangle and printing what's + # underneath the rectangle's area. + + proc itemMark {c x y} { + global areaX1 areaY1 + set areaX1 [$c canvasx $x] + set areaY1 [$c canvasy $y] + $c delete area + } + + proc itemStroke {c x y} { + global areaX1 areaY1 areaX2 areaY2 + set x [$c canvasx $x] + set y [$c canvasy $y] + if {($areaX1 != $x) && ($areaY1 != $y)} { + $c delete area + $c addtag area withtag [$c create rect $areaX1 $areaY1 $x $y \ + -outline black] + set areaX2 $x + set areaY2 $y + } + } + + proc itemsUnderArea {c} { + global areaX1 areaY1 areaX2 areaY2 + set area [$c find withtag area] + set items "" + foreach i [$c find enclosed $areaX1 $areaY1 $areaX2 $areaY2] { + if {[lsearch [$c gettags $i] item] != -1} { + lappend items $i + } + } + puts stdout "Items enclosed by area: $items" + set items "" + foreach i [$c find overlapping $areaX1 $areaY1 $areaX2 $areaY2] { + if {[lsearch [$c gettags $i] item] != -1} { + lappend items $i + } + } + puts stdout "Items overlapping area: $items" + } + + set areaX1 0 + set areaY1 0 + set areaX2 0 + set areaY2 0 + + # Utility procedures to support dragging of items. + + proc itemStartDrag {c x y} { + global lastX lastY + set lastX [$c canvasx $x] + set lastY [$c canvasy $y] + } + + proc itemDrag {c x y} { + global lastX lastY + set x [$c canvasx $x] + set y [$c canvasy $y] + $c move current [expr $x-$lastX] [expr $y-$lastY] + set lastX $x + set lastY $y + } + + # Procedure that's invoked when the button embedded in the canvas + # is invoked. + + proc butPress {w color} { + set i [$w create text 25c 18.1c -text "いてて!!" -fill $color -anchor n] + after 500 "$w delete $i" + } diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/ixset ./library/demos.jp/ixset *** ../tk4.2/library/demos.jp/ixset Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/ixset Sun Nov 24 18:25:55 1996 *************** *** 0 **** --- 1,312 ---- + #!/bin/sh + # the next line restarts using wish \ + exec wish "$0" "$@" + + # ixset -- + # A nice interface to "xset" to change X server settings + # + # History : + # 91/11/23 : pda@masi.ibp.fr, jt@ratp.fr : design + # 92/08/01 : pda@masi.ibp.fr : cleaning + # + # SCCS: @(#) ixset 1.7 96/02/16 10:49:19 + + # + # Button actions + # + + proc quit {} { + destroy . + } + + proc ok {} { + writesettings + quit + } + + proc cancel {} { + readsettings + dispsettings + } + + # apply is just "writesettings" + + + # + # Read current settings + # + + proc readsettings {} { + global kbdrep ; set kbdrep "on" + global kbdcli ; set kbdcli 0 + global bellvol ; set bellvol 100 + global bellpit ; set bellpit 440 + global belldur ; set belldur 100 + global mouseacc ; set mouseacc "3/1" + global mousethr ; set mousethr 4 + global screenbla ; set screenbla "blank" + global screentim ; set screentim 600 + global screencyc ; set screencyc 600 + + set xfd [open "|xset q" r] + while {[gets $xfd line] > -1} { + set kw [lindex $line 0] + + case $kw in { + {auto} + { + set rpt [lindex $line 1] + if {[expr "{$rpt} == {repeat:}"]} then { + set kbdrep [lindex $line 2] + set kbdcli [lindex $line 6] + } + } + {bell} + { + set bellvol [lindex $line 2] + set bellpit [lindex $line 5] + set belldur [lindex $line 8] + } + {acceleration:} + { + set mouseacc [lindex $line 1] + set mousethr [lindex $line 3] + } + {prefer} + { + set bla [lindex $line 2] + set screenbla [expr "{$bla} == {yes} ? {blank} : {noblank}"] + } + {timeout:} + { + set screentim [lindex $line 1] + set screencyc [lindex $line 3] + } + } + } + close $xfd + + # puts stdout [format "Key REPEAT = %s\n" $kbdrep] + # puts stdout [format "Key CLICK = %s\n" $kbdcli] + # puts stdout [format "Bell VOLUME = %s\n" $bellvol] + # puts stdout [format "Bell PITCH = %s\n" $bellpit] + # puts stdout [format "Bell DURATION = %s\n" $belldur] + # puts stdout [format "Mouse ACCELERATION = %s\n" $mouseacc] + # puts stdout [format "Mouse THRESHOLD = %s\n" $mousethr] + # puts stdout [format "Screen BLANCK = %s\n" $screenbla] + # puts stdout [format "Screen TIMEOUT = %s\n" $screentim] + # puts stdout [format "Screen CYCLE = %s\n" $screencyc] + } + + + # + # Write settings into the X server + # + + proc writesettings {} { + global kbdrep kbdcli bellvol bellpit belldur + global mouseacc mousethr screenbla screentim screencyc + + set bellvol [.bell.vol get] + set bellpit [.bell.val.pit.entry get] + set belldur [.bell.val.dur.entry get] + + if {[expr "{$kbdrep} == {on}"]} then { + set kbdcli [.kbd.val.cli get] + } else { + set kbdcli "off" + } + + set mouseacc [.mouse.hor.acc.entry get] + set mousethr [.mouse.hor.thr.entry get] + + set screentim [.screen.val.le.tim.entry get] + set screencyc [.screen.val.le.cyc.entry get] + + exec xset \ + b $bellvol $bellpit $belldur \ + c $kbdcli \ + r $kbdrep \ + m $mouseacc $mousethr \ + s $screentim $screencyc \ + s $screenbla + } + + + # + # Sends all settings to the window + # + + proc dispsettings {} { + global kbdrep kbdcli bellvol bellpit belldur + global mouseacc mousethr screenbla screentim screencyc + + .bell.vol set $bellvol + .bell.val.pit.entry delete 0 end + .bell.val.pit.entry insert 0 $bellpit + .bell.val.dur.entry delete 0 end + .bell.val.dur.entry insert 0 $belldur + + .kbd.val.onoff [expr "{$kbdrep} == {on} ? {select} : {deselect}"] + .kbd.val.cli set $kbdcli + + .mouse.hor.acc.entry delete 0 end + .mouse.hor.acc.entry insert 0 $mouseacc + .mouse.hor.thr.entry delete 0 end + .mouse.hor.thr.entry insert 0 $mousethr + + .screen.val.rb.blank [expr "{$screenbla}=={blank} ? {select} : {deselect}"] + .screen.val.rb.pat [expr "{$screenbla}!={blank} ? {select} : {deselect}"] + .screen.val.le.tim.entry delete 0 end + .screen.val.le.tim.entry insert 0 $screentim + .screen.val.le.cyc.entry delete 0 end + .screen.val.le.cyc.entry insert 0 $screencyc + } + + + # + # Create all windows, and pack them + # + + proc labelentry {path text length} { + frame $path + label $path.label -text $text + entry $path.entry -width $length -relief sunken + pack $path.label -side left -expand y + pack $path.entry -side right -expand y + } + + proc createwindows {} { + # + # Buttons + # + + frame .buttons + button .buttons.ok -command "ok" -text "Ok" + button .buttons.apply -command "writesettings" -text "Apply" + button .buttons.cancel -command "cancel" -text "Cancel" + button .buttons.quit -command "quit" -text "Quit" + + pack .buttons.ok .buttons.apply .buttons.cancel .buttons.quit \ + -side left -expand yes -pady 5 + + # + # Bell settings + # + + frame .bell -relief raised -borderwidth 2 + label .bell.label -text "Bell Settings" + scale .bell.vol \ + -from 0 -to 100 -length 200 -tickinterval 20 \ + -label "Volume (%)" -orient horizontal + + frame .bell.val + labelentry .bell.val.pit "Pitch (Hz)" 6 + labelentry .bell.val.dur "Duration (ms)" 6 + pack .bell.val.pit -side left -padx 5 + pack .bell.val.dur -side right -padx 5 + pack .bell.label .bell.vol .bell.val -side top -expand yes + + # + # Keyboard settings + # + + frame .kbd -relief raised -borderwidth 2 + + label .kbd.label -text "Keyboard Repeat Settings" + + frame .kbd.val + checkbutton .kbd.val.onoff \ + -text "On" \ + -onvalue "on" -offvalue "off" -variable kbdrep \ + -relief flat + scale .kbd.val.cli \ + -from 0 -to 100 -length 200 -tickinterval 20 \ + -label "Click Volume (%)" -orient horizontal + pack .kbd.val.onoff -side left -expand yes -fill both + pack .kbd.val.cli -side left -expand yes + + pack .kbd.label -side top -expand yes + pack .kbd.val -side top -expand yes -pady 2 -fill x + + # + # Mouse settings + # + + frame .mouse -relief raised -borderwidth 2 + + label .mouse.label -text "Mouse Settings" + frame .mouse.hor + labelentry .mouse.hor.acc "Acceleration" 3 + labelentry .mouse.hor.thr "Threshold (pixels)" 3 + + pack .mouse.hor.acc -side left + pack .mouse.hor.thr -side right + + pack .mouse.label -side top + pack .mouse.hor -side top -expand yes + + # + # Screen Saver settings + # + + frame .screen -relief raised -borderwidth 2 + + label .screen.label -text "Screen-saver Settings" + frame .screen.val + + frame .screen.val.rb + radiobutton .screen.val.rb.blank \ + -variable screenblank -text "Blank" -relief flat \ + -value "blank" -variable screenbla + radiobutton .screen.val.rb.pat \ + -variable screenblank -text "Pattern" -relief flat \ + -value "noblank" -variable screenbla + pack .screen.val.rb.blank .screen.val.rb.pat -side top -pady 2 -anchor w + frame .screen.val.le + labelentry .screen.val.le.tim "Timeout (s)" 5 + labelentry .screen.val.le.cyc "Cycle (s)" 5 + pack .screen.val.le.tim .screen.val.le.cyc -side top -pady 2 -anchor e + + pack .screen.val.rb .screen.val.le -side left + + pack .screen.label -side top + pack .screen.val -side top -expand y + + # + # Main window + # + + pack .buttons -side top -fill both + pack .bell .kbd .mouse .screen -side top -fill both -ipady 5 -expand yes + + # + # Let the user resize our window + # + wm minsize . 10 10 + } + + ############################################################################## + # Main program + + # + # Listen what "xset" tells us... + # + + readsettings + + # + # Create all windows + # + + createwindows + + # + # Write xset parameters + # + + dispsettings + + # + # Now, wait for user actions... + # diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/label.tcl ./library/demos.jp/label.tcl *** ../tk4.2/library/demos.jp/label.tcl Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/label.tcl Sun Nov 24 18:25:55 1996 *************** *** 0 **** --- 1,36 ---- + # label.tcl -- + # + # This demonstration script creates a toplevel window containing + # several label widgets. + # + # SCCS: @(#) label.tcl 1.6 96/04/12 12:06:20 + + set w .label + catch {destroy $w} + toplevel $w + wm title $w "Label Demonstration" + wm iconname $w "label" + positionWindow $w + + label $w.msg -font $font -wraplength 4i -justify left -text "下には 5つのラベルが表示されています。左側にはテキストラベルが 3つあり、右側にはビットマップラベルとテキストラベルがあります。ラベルというのはあまり面白いものではありません。なぜなら眺める以外何もできないからです。" + pack $w.msg -side top + + frame $w.buttons + pack $w.buttons -side bottom -fill x -pady 2m + button $w.buttons.dismiss -text 了解 -command "destroy $w" + button $w.buttons.code -text "コード参照" -command "showCode $w" + pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 + + frame $w.left + frame $w.right + pack $w.left $w.right -side left -expand yes -padx 10 -pady 10 -fill both + + label $w.left.l1 -text "最初のラベル" + label $w.left.l2 -text "2 番目。ちょっと浮き上がらせてみました" -relief raised + label $w.left.l3 -text "3 番目。沈んでいます " -relief sunken + pack $w.left.l1 $w.left.l2 $w.left.l3 -side top -expand yes -pady 2 -anchor w + + label $w.right.bitmap -borderwidth 2 -relief sunken \ + -bitmap @[file join $tk_library demos images face.bmp] + label $w.right.caption -text "Tcl/Tk 所有者" + pack $w.right.bitmap $w.right.caption -side top diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/license.terms ./library/demos.jp/license.terms *** ../tk4.2/library/demos.jp/license.terms Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/license.terms Sun Nov 24 18:25:55 1996 *************** *** 0 **** --- 1,39 ---- + This software is copyrighted by the Regents of the University of + California, Sun Microsystems, Inc., and other parties. The following + terms apply to all files associated with the software unless explicitly + disclaimed in individual files. + + The authors hereby grant permission to use, copy, modify, distribute, + and license this software and its documentation for any purpose, provided + that existing copyright notices are retained in all copies and that this + notice is included verbatim in any distributions. No written agreement, + license, or royalty fee is required for any of the authorized uses. + Modifications to this software may be copyrighted by their authors + and need not follow the licensing terms described here, provided that + the new terms are clearly indicated on the first page of each file where + they apply. + + IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY + FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES + ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY + DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE + POSSIBILITY OF SUCH DAMAGE. + + THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, + INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE + IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE + NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR + MODIFICATIONS. + + GOVERNMENT USE: If you are acquiring this software on behalf of the + U.S. government, the Government shall have only "Restricted Rights" + in the software and related documentation as defined in the Federal + Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you + are acquiring the software on behalf of the Department of Defense, the + software shall be classified as "Commercial Computer Software" and the + Government shall have only "Restricted Rights" as defined in Clause + 252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the + authors grant the U.S. Government and others acting in its behalf + permission to use and distribute the software in accordance with the + terms specified in this license. diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/menu.tcl ./library/demos.jp/menu.tcl *** ../tk4.2/library/demos.jp/menu.tcl Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/menu.tcl Sun Nov 24 18:25:55 1996 *************** *** 0 **** --- 1,121 ---- + # menu.tcl -- + # + # This demonstration script creates a window with a bunch of menus + # and cascaded menus. + # + # SCCS: @(#) menu.tcl 1.7 96/04/12 11:57:35 + + set w .menu + catch {destroy $w} + toplevel $w + wm title $w "Menu Demonstration" + wm iconname $w "menu" + positionWindow $w + + frame $w.menu -relief raised -bd 2 + pack $w.menu -side top -fill x + + label $w.msg -font $font -wraplength 4i -justify left -text "このウィンドウは様々なメニューとカスケードメニューから構成されています。Alt-X を入力すると、Xがメニューにアンダーライン付きで表示されている文字ならば、キーボードからの指定ができます。矢印キーでメニューのトラバースも可能です。メニューが指定された際には、スペースキーで実行することができます。あるいは、アンダーライン付きの文字を入力することでも実行できます。メニューのエントリがアクセラレータを持っている場合は、そのアクセラレータを入力することでメニューを指定することなしに実行することができます。" + pack $w.msg -side top + + frame $w.buttons + pack $w.buttons -side bottom -fill x -pady 2m + button $w.buttons.dismiss -text 了解 -command "destroy $w" + button $w.buttons.code -text "コード参照" -command "showCode $w" + pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 + + set m $w.menu.file.m + menubutton $w.menu.file -text "File" -menu $m -underline 0 + menu $m + $m add command -label "開く ..." -command {error "これは、デモですので\"開く ...\"に対するアクションは定義されていません。"} + $m add command -label "新規" -command {error "これは、デモですので\"新規 ...\"に対するアクションは定義されていません。"} + $m add command -label "保存" -command {error "これは、デモですので\"保存 ...\"に対するアクションは定義されていません。"} + $m add command -label "保存(指定) ..." -command {error "これは、デモですので\"保存(指定) ...\"に対するアクションは定義されていません。"} + $m add separator + $m add command -label "プリント設定 ..." -command {error "これは、デモですので\"プリント設定 ...\"に対するアクションは定義されていません。"} + $m add command -label "プリント ..." -command {error "これは、デモですので\"プリント ...\"に対するアクションは定義されていません。"} + $m add separator + $m add command -label "終了" -command "destroy $w" + + set m $w.menu.basic.m + menubutton $w.menu.basic -text "Basic" -menu $m -underline 0 + menu $m + $m add command -label "何もしない長いエントリ" + foreach i {a b c d e f g} { + $m add command -label "文字 \"$i\" を印字" -underline 14 \ + -accelerator Meta+$i -command "puts $i" + bind $w "puts $i" + } + + set m $w.menu.cascade.m + menubutton $w.menu.cascade -text "Cascades" -menu $m -underline 0 + menu $m + $m add command -label こんにちは \ + -command {puts stdout こんにちは} -accelerator Control+a -underline 0 + bind . {puts stdout こんにちは} + $m add command -label さようなら -command {\ + puts stdout さようなら} -accelerator Control+b -underline 0 + bind . {puts stdout さようなら} + $m add cascade -label チェックボタン \ + -menu $w.menu.cascade.m.check -underline 0 + $m add cascade -label ラジオボタン \ + -menu $w.menu.cascade.m.radio -underline 0 + + set m $w.menu.cascade.m.check + menu $m + $m add check -label "オイル点検" -variable oil + $m add check -label "トランスミッション点検" -variable trans + $m add check -label "ブレーキ点検" -variable brakes + $m add check -label "ライト点検" -variable lights + $m add separator + $m add command -label "現在の値を表示" \ + -command "showVars $w.menu.cascade.dialog oil trans brakes lights" + $m invoke 1 + $m invoke 3 + + set m $w.menu.cascade.m.radio + menu $m + $m add radio -label "10 ポイント" -variable pointSize -value 10 + $m add radio -label "14 ポイント" -variable pointSize -value 14 + $m add radio -label "18 ポイント" -variable pointSize -value 18 + $m add radio -label "24 ポイント" -variable pointSize -value 24 + $m add radio -label "32 ポイント" -variable pointSize -value 32 + $m add sep + $m add radio -label "ローマン" -variable style -value roman + $m add radio -label "ボールド" -variable style -value bold + $m add radio -label "イタリック" -variable style -value italic + $m add sep + $m add command -label "現在の値を表示" \ + -command "showVars $w.menu.cascade.dialog pointSize style" + $m invoke 1 + $m invoke 7 + + set m $w.menu.icon.m + menubutton $w.menu.icon -text "Icons" -menu $m -underline 0 + menu $m + $m add command \ + -bitmap @[file join $tk_library demos images pattern.bmp] \ + -command { + tk_dialog .pattern {Bitmap Menu Entry} {今あなたが選択したメニューの項目はテキストではなくビットマップを表示していました。それ以外の点では他のメニュー項目と変わりません。} {} 0 了解 + } + foreach i {info questhead error} { + $m add command -bitmap $i -command "puts {You invoked the $i bitmap}" + } + + set m $w.menu.more.m + menubutton $w.menu.more -text "More" -menu $m -underline 0 + menu $m + foreach i {{エントリ} {別のエントリ} {何もしない} {ほとんど何もしない} {人生を意義あるものに}} { + $m add command -label $i -command [list puts "You invoked \"$i\""] + } + + set m $w.menu.colors.m + menubutton $w.menu.colors -text "Colors" -menu $m -underline 1 + menu $m + foreach i {red orange yellow green blue} { + $m add command -label $i -background $i \ + -command [list puts "You invoked \"$i\""] + } + + pack $w.menu.file $w.menu.basic $w.menu.cascade $w.menu.icon $w.menu.more \ + $w.menu.colors -side left diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/msgbox.tcl ./library/demos.jp/msgbox.tcl *** ../tk4.2/library/demos.jp/msgbox.tcl Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/msgbox.tcl Sun Nov 24 18:38:17 1996 *************** *** 0 **** --- 1,61 ---- + # msgbox.tcl -- + # + # This demonstration script creates message boxes of various type + # + # SCCS: @(#) msgbox.tcl 1.2 96/08/27 14:42:23 + + set w .msgbox + catch {destroy $w} + toplevel $w + wm title $w "Message Box Demonstration" + wm iconname $w "messagebox" + positionWindow $w + + label $w.msg -font $font -wraplength 4i -justify left -text "\ｦACRbZ[W{bNXIB \"bZ[W{bNX\" {^AwbZ[W{bNX\ｦB" + pack $w.msg -side top + + frame $w.buttons + pack $w.buttons -side bottom -fill x -pady 2m + button $w.buttons.dismiss -text -command "destroy $w" + button $w.buttons.code -text R[hQ -command "showCode $w" + button $w.buttons.vars -text bZ[W{bNX \ + -command "showMessageBox $w" + pack $w.buttons.dismiss $w.buttons.code $w.buttons.vars -side left -expand 1 + + frame $w.left + frame $w.right + pack $w.left $w.right -side left -expand yes -fill y -pady .5c -padx .5c + + label $w.left.label -text ACR + frame $w.left.sep -relief ridge -bd 1 -height 2 + pack $w.left.label -side top + pack $w.left.sep -side top -fill x -expand no + + set msgboxIcon info + foreach i {error info question warning} { + radiobutton $w.left.b$i -text $i -variable msgboxIcon \ + -relief flat -value $i -width 16 -anchor w + pack $w.left.b$i -side top -pady 2 -anchor w -fill x + } + + label $w.right.label -text + frame $w.right.sep -relief ridge -bd 1 -height 2 + pack $w.right.label -side top + pack $w.right.sep -side top -fill x -expand no + + set msgboxType ok + foreach t {abortretryignore ok okcancel retrycancel yesno yesnocancel} { + radiobutton $w.right.$t -text $t -variable msgboxType \ + -relief flat -value $t -width 16 -anchor w + pack $w.right.$t -side top -pady 2 -anchor w -fill x + } + + proc showMessageBox {w} { + global msgboxIcon msgboxType + set button [tk_messageBox -icon $msgboxIcon -type $msgboxType \ + -title Message -parent $w\ + -message " \"$msgboxType\" bZ[W{bNXA\"$msgboxIcon\" ACR\ｦB"] + + tk_messageBox -icon info -message " \"$button\" B" -type ok\ + -parent $w + } diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/plot.tcl ./library/demos.jp/plot.tcl *** ../tk4.2/library/demos.jp/plot.tcl Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/plot.tcl Sun Nov 24 18:25:55 1996 *************** *** 0 **** --- 1,94 ---- + # plot.tcl -- + # + # This demonstration script creates a canvas widget showing a 2-D + # plot with data points that can be dragged with the mouse. + # + # SCCS: @(#) plot.tcl 1.3 96/02/16 10:49:46 + + set w .plot + catch {destroy $w} + toplevel $w + wm title $w "Plot Demonstration" + wm iconname $w "Plot" + positionWindow $w + set c $w.c + + label $w.msg -font $font -wraplength 4i -justify left -text "このウィンドウは簡単な2次元のプロットを含んだキャンバス widget です。表示された点をマウスボタン1 でドラッグしてデータをいじることができます。" + pack $w.msg -side top + + frame $w.buttons + pack $w.buttons -side bottom -fill x -pady 2m + button $w.buttons.dismiss -text 了解 -command "destroy $w" + button $w.buttons.code -text "コード参照" -command "showCode $w" + pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 + + canvas $c -relief raised -width 450 -height 300 + pack $w.c -side top -fill x + + set plotFont -*-Helvetica-Medium-R-Normal--*-180-*-*-*-*-*-* + + $c create line 100 250 400 250 -width 2 + $c create line 100 250 100 50 -width 2 + $c create text 225 20 -text "簡単なプロット" -font $plotFont -fill brown + + for {set i 0} {$i <= 10} {incr i} { + set x [expr {100 + ($i*30)}] + $c create line $x 250 $x 245 -width 2 + $c create text $x 254 -text [expr 10*$i] -anchor n -font $plotFont + } + for {set i 0} {$i <= 5} {incr i} { + set y [expr {250 - ($i*40)}] + $c create line 100 $y 105 $y -width 2 + $c create text 96 $y -text [expr $i*50].0 -anchor e -font $plotFont + } + + foreach point {{12 56} {20 94} {33 98} {32 120} {61 180} + {75 160} {98 223}} { + set x [expr {100 + (3*[lindex $point 0])}] + set y [expr {250 - (4*[lindex $point 1])/5}] + set item [$c create oval [expr $x-6] [expr $y-6] \ + [expr $x+6] [expr $y+6] -width 1 -outline black \ + -fill SkyBlue2] + $c addtag point withtag $item + } + + $c bind point "$c itemconfig current -fill red" + $c bind point "$c itemconfig current -fill SkyBlue2" + $c bind point <1> "plotDown $c %x %y" + $c bind point "$c dtag selected" + bind $c "plotMove $c %x %y" + + set plot(lastX) 0 + set plot(lastY) 0 + + # plotDown -- + # This procedure is invoked when the mouse is pressed over one of the + # data points. It sets up state to allow the point to be dragged. + # + # Arguments: + # w - The canvas window. + # x, y - The coordinates of the mouse press. + + proc plotDown {w x y} { + global plot + $w dtag selected + $w addtag selected withtag current + $w raise current + set plot(lastX) $x + set plot(lastY) $y + } + + # plotMove -- + # This procedure is invoked during mouse motion events. It drags the + # current item. + # + # Arguments: + # w - The canvas window. + # x, y - The coordinates of the mouse. + + proc plotMove {w x y} { + global plot + $w move selected [expr $x-$plot(lastX)] [expr $y-$plot(lastY)] + set plot(lastX) $x + set plot(lastY) $y + } diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/puzzle.tcl ./library/demos.jp/puzzle.tcl *** ../tk4.2/library/demos.jp/puzzle.tcl Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/puzzle.tcl Sun Nov 24 18:25:55 1996 *************** *** 0 **** --- 1,69 ---- + # puzzle.tcl -- + # + # This demonstration script creates a 15-puzzle game using a collection + # of buttons. + # + # SCCS: @(#) puzzle.tcl 1.4 96/02/16 10:49:48 + + # puzzleSwitch -- + # This procedure is invoked when the user clicks on a particular button; + # if the button is next to the empty space, it moves the button into th + # empty space. + + proc puzzleSwitch {w num} { + global xpos ypos + if {(($ypos($num) >= ($ypos(space) - .01)) + && ($ypos($num) <= ($ypos(space) + .01)) + && ($xpos($num) >= ($xpos(space) - .26)) + && ($xpos($num) <= ($xpos(space) + .26))) + || (($xpos($num) >= ($xpos(space) - .01)) + && ($xpos($num) <= ($xpos(space) + .01)) + && ($ypos($num) >= ($ypos(space) - .26)) + && ($ypos($num) <= ($ypos(space) + .26)))} { + set tmp $xpos(space) + set xpos(space) $xpos($num) + set xpos($num) $tmp + set tmp $ypos(space) + set ypos(space) $ypos($num) + set ypos($num) $tmp + place $w.frame.$num -relx $xpos($num) -rely $ypos($num) + } + } + + set w .puzzle + catch {destroy $w} + toplevel $w + wm title $w "15-Puzzle Demonstration" + wm iconname $w "15-Puzzle" + positionWindow $w + + label $w.msg -font $font -wraplength 4i -justify left -text "下の 15-パズルはボタンを集めてできています。空いている所の隣のピースをクリックすると、そのピースがその空いている場所にスライドします。この操作を続け、ピースがその数の順に上から下、左から右に並ぶようにしてください。" + pack $w.msg -side top + + frame $w.buttons + pack $w.buttons -side bottom -fill x -pady 2m + button $w.buttons.dismiss -text 了解 -command "destroy $w" + button $w.buttons.code -text "コード参照" -command "showCode $w" + pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 + + # Special trick: select a darker color for the space by creating a + # scrollbar widget and using its trough color. + + scrollbar $w.s + frame $w.frame -width 120 -height 120 -borderwidth 2 -relief sunken \ + -bg [$w.s cget -troughcolor] + pack $w.frame -side top -pady 1c -padx 1c + destroy $w.s + + set order {3 1 6 2 5 7 15 13 4 11 8 9 14 10 12} + for {set i 0} {$i < 15} {set i [expr $i+1]} { + set num [lindex $order $i] + set xpos($num) [expr ($i%4)*.25] + set ypos($num) [expr ($i/4)*.25] + button $w.frame.$num -relief raised -text $num -highlightthickness 0 \ + -command "puzzleSwitch $w $num" + place $w.frame.$num -relx $xpos($num) -rely $ypos($num) \ + -relwidth .25 -relheight .25 + } + set xpos(space) .75 + set ypos(space) .75 diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/radio.tcl ./library/demos.jp/radio.tcl *** ../tk4.2/library/demos.jp/radio.tcl Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/radio.tcl Sun Nov 24 18:25:55 1996 *************** *** 0 **** --- 1,40 ---- + # radio.tcl -- + # + # This demonstration script creates a toplevel window containing + # several radiobutton widgets. + # + # SCCS: @(#) radio.tcl 1.4 96/02/16 10:49:34 + + set w .radio + catch {destroy $w} + toplevel $w + wm title $w "Radiobutton Demonstration" + wm iconname $w "radio" + positionWindow $w + label $w.msg -font $font -wraplength 5i -justify left -text "下には 2つのラジオボタングループが表示されています。ボタンをクリックすると、そのボタンだけがそのグループの中で選択されます。各グループに対してそのグループの中のどのボタンが選択されているかを示す変数が割り当てられています。現在の変数の値を見るには「変数参照」ボタンをクリックしてください。" + pack $w.msg -side top + + frame $w.buttons + pack $w.buttons -side bottom -fill x -pady 2m + button $w.buttons.dismiss -text 了解 -command "destroy $w" + button $w.buttons.code -text "コード参照" -command "showCode $w" + button $w.buttons.vars -text "変数参照" \ + -command "showVars $w.dialog size color" + pack $w.buttons.dismiss $w.buttons.code $w.buttons.vars -side left -expand 1 + + frame $w.left + frame $w.right + pack $w.left $w.right -side left -expand yes -pady .5c -padx .5c + + foreach i {10 12 18 24} { + radiobutton $w.left.b$i -text "ポイントサイズ $i" -variable size \ + -relief flat -value $i + pack $w.left.b$i -side top -pady 2 -anchor w + } + + foreach color {赤 緑 青 黄 橙 紫} { + set lower [string tolower $color] + radiobutton $w.right.$lower -text $color -variable color \ + -relief flat -value $lower + pack $w.right.$lower -side top -pady 2 -anchor w + } diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/rmt ./library/demos.jp/rmt *** ../tk4.2/library/demos.jp/rmt Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/rmt Sun Nov 24 18:25:55 1996 *************** *** 0 **** --- 1,205 ---- + #!/bin/sh + # the next line restarts using wish \ + exec wish "$0" "$@" + + # rmt -- + # This script implements a simple remote-control mechanism for + # Tk applications. It allows you to select an application and + # then type commands to that application. + # + # SCCS: @(#) rmt 1.9 96/02/16 10:49:22 + + wm title . "Tk Remote Controller" + wm iconname . "Tk Remote" + wm minsize . 1 1 + + # The global variable below keeps track of the remote application + # that we're sending to. If it's an empty string then we execute + # the commands locally. + + set app "local" + + # The global variable below keeps track of whether we're in the + # middle of executing a command entered via the text. + + set executing 0 + + # The global variable below keeps track of the last command executed, + # so it can be re-executed in response to !! commands. + + set lastCommand "" + + # Create menu bar. Arrange to recreate all the information in the + # applications sub-menu whenever it is cascaded to. + + frame .menu -relief raised -bd 2 + pack .menu -side top -fill x + menubutton .menu.file -text "File" -menu .menu.file.m -underline 0 + menu .menu.file.m + .menu.file.m add cascade -label "Select Application" \ + -menu .menu.file.m.apps -underline 0 + .menu.file.m add command -label "Quit" -command "destroy ." -underline 0 + menu .menu.file.m.apps -postcommand fillAppsMenu + pack .menu.file -side left + + # Create text window and scrollbar. + + text .t -relief sunken -bd 2 -yscrollcommand ".s set" -setgrid true + scrollbar .s -command ".t yview" + pack .s -side right -fill both + pack .t -side left + + # Create a binding to forward commands to the target application, + # plus modify many of the built-in bindings so that only information + # in the current command can be deleted (can still set the cursor + # earlier in the text and select and insert; just can't delete). + + bindtags .t {.t Text . all} + bind .t { + .t mark set insert {end - 1c} + .t insert insert \n + invoke + break + } + bind .t { + catch {.t tag remove sel sel.first promptEnd} + if {[.t tag nextrange sel 1.0 end] == ""} { + if [.t compare insert < promptEnd] { + break + } + } + } + bind .t { + catch {.t tag remove sel sel.first promptEnd} + if {[.t tag nextrange sel 1.0 end] == ""} { + if [.t compare insert <= promptEnd] { + break + } + } + } + bind .t { + if [.t compare insert < promptEnd] { + break + } + } + bind .t { + if [.t compare insert < promptEnd] { + .t mark set insert promptEnd + } + } + bind .t { + if [.t compare insert < promptEnd] { + break + } + } + bind .t { + if [.t compare insert < promptEnd] { + break + } + } + bind .t { + if [.t compare insert <= promptEnd] { + break + } + } + bind .t { + if [.t compare insert <= promptEnd] { + break + } + } + auto_load tkTextInsert + proc tkTextInsert {w s} { + if {$s == ""} { + return + } + catch { + if {[$w compare sel.first <= insert] + && [$w compare sel.last >= insert]} { + $w tag remove sel sel.first promptEnd + $w delete sel.first sel.last + } + } + $w insert insert $s + $w see insert + } + + .t tag configure bold -font -*-Courier-Bold-R-Normal-*-120-*-*-*-*-*-* + + # The procedure below is used to print out a prompt at the + # insertion point (which should be at the beginning of a line + # right now). + + proc prompt {} { + global app + .t insert insert "$app: " + .t mark set promptEnd {insert} + .t mark gravity promptEnd left + .t tag add bold {promptEnd linestart} promptEnd + } + + # The procedure below executes a command (it takes everything on the + # current line after the prompt and either sends it to the remote + # application or executes it locally, depending on "app". + + proc invoke {} { + global app executing lastCommand + set cmd [.t get promptEnd insert] + incr executing 1 + if [info complete $cmd] { + if {$cmd == "!!\n"} { + set cmd $lastCommand + } else { + set lastCommand $cmd + } + if {$app == "local"} { + set result [catch [list uplevel #0 $cmd] msg] + } else { + set result [catch [list send $app $cmd] msg] + } + if {$result != 0} { + .t insert insert "Error: $msg\n" + } else { + if {$msg != ""} { + .t insert insert $msg\n + } + } + prompt + .t mark set promptEnd insert + } + incr executing -1 + .t yview -pickplace insert + } + + # The following procedure is invoked to change the application that + # we're talking to. It also updates the prompt for the current + # command, unless we're in the middle of executing a command from + # the text item (in which case a new prompt is about to be output + # so there's no need to change the old one). + + proc newApp appName { + global app executing + set app $appName + if !$executing { + .t mark gravity promptEnd right + .t delete "promptEnd linestart" promptEnd + .t insert promptEnd "$appName: " + .t tag add bold "promptEnd linestart" promptEnd + .t mark gravity promptEnd left + } + return {} + } + + # The procedure below will fill in the applications sub-menu with a list + # of all the applications that currently exist. + + proc fillAppsMenu {} { + catch {.menu.file.m.apps delete 0 last} + foreach i [lsort [winfo interps]] { + .menu.file.m.apps add command -label $i -command [list newApp $i] + } + .menu.file.m.apps add command -label local -command {newApp local} + } + + set app [winfo name .] + prompt + focus .t diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/rolodex ./library/demos.jp/rolodex *** ../tk4.2/library/demos.jp/rolodex Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/rolodex Sun Nov 24 18:25:55 1996 *************** *** 0 **** --- 1,196 ---- + #!/bin/sh + # the next line restarts using wish \ + exec wish "$0" "$@" + + # rolodex -- + # This script was written as an entry in Tom LaStrange's rolodex + # benchmark. It creates something that has some of the look and + # feel of a rolodex program, although it's lifeless and doesn't + # actually do the rolodex application. + # + # SCCS: @(#) rolodex 1.7 96/02/16 10:49:23 + + foreach i [winfo child .] { + catch {destroy $i} + } + + #------------------------------------------ + # Phase 0: create the front end. + #------------------------------------------ + + frame .frame -relief flat + pack .frame -side top -fill y -anchor center + + set names {{} Name: Address: {} {} {Home Phone:} {Work Phone:} Fax:} + foreach i {1 2 3 4 5 6 7} { + frame .frame.$i + pack .frame.$i -side top -pady 2 -anchor e + + label .frame.$i.label -text [lindex $names $i] -anchor e + entry .frame.$i.entry -width 30 -relief sunken + pack .frame.$i.entry .frame.$i.label -side right + } + + frame .buttons + pack .buttons -side bottom -pady 2 -anchor center + button .buttons.clear -text Clear + button .buttons.add -text Add + button .buttons.search -text Search + button .buttons.delete -text "Delete ..." + pack .buttons.clear .buttons.add .buttons.search .buttons.delete \ + -side left -padx 2 + + #------------------------------------------ + # Phase 1: Add menus, dialog boxes + #------------------------------------------ + + frame .menu -relief raised -borderwidth 1 + pack .menu -before .frame -side top -fill x + + menubutton .menu.file -text "File" -menu .menu.file.m -underline 0 + menu .menu.file.m + .menu.file.m add command -label "Load ..." -command fileAction -underline 0 + .menu.file.m add command -label "Exit" -command {destroy .} -underline 0 + pack .menu.file -side left + + menubutton .menu.help -text "Help" -menu .menu.help.m -underline 0 + menu .menu.help.m + pack .menu.help -side right + + proc deleteAction {} { + if {[tk_dialog .delete {Confirm Action} {Are you sure?} {} 0 Cancel] + == 0} { + clearAction + } + } + .buttons.delete config -command deleteAction + + proc fileAction {} { + tk_dialog .fileSelection {File Selection} {This is a dummy file selection dialog box, which is used because there isn't a good file selection dialog built into Tk yet.} {} 0 OK + puts stderr {dummy file name} + } + + #------------------------------------------ + # Phase 3: Print contents of card + #------------------------------------------ + + proc addAction {} { + global names + foreach i {1 2 3 4 5 6 7} { + puts stderr [format "%-12s %s" [lindex $names $i] [.frame.$i.entry get]] + } + } + .buttons.add config -command addAction + + #------------------------------------------ + # Phase 4: Miscellaneous other actions + #------------------------------------------ + + proc clearAction {} { + foreach i {1 2 3 4 5 6 7} { + .frame.$i.entry delete 0 end + } + } + .buttons.clear config -command clearAction + + proc fillCard {} { + clearAction + .frame.1.entry insert 0 "John Ousterhout" + .frame.2.entry insert 0 "CS Division, Department of EECS" + .frame.3.entry insert 0 "University of California" + .frame.4.entry insert 0 "Berkeley, CA 94720" + .frame.5.entry insert 0 "private" + .frame.6.entry insert 0 "510-642-0865" + .frame.7.entry insert 0 "510-642-5775" + } + .buttons.search config -command "addAction; fillCard" + + #---------------------------------------------------- + # Phase 5: Accelerators, mnemonics, command-line info + #---------------------------------------------------- + + .buttons.clear config -text "Clear Ctrl+C" + bind . clearAction + .buttons.add config -text "Add Ctrl+A" + bind . addAction + .buttons.search config -text "Search Ctrl+S" + bind . "addAction; fillCard" + .buttons.delete config -text "Delete... Ctrl+D" + bind . deleteAction + + .menu.file.m entryconfig 1 -accel Ctrl+F + bind . fileAction + .menu.file.m entryconfig 2 -accel Ctrl+Q + bind . {destroy .} + + focus .frame.1.entry + + #---------------------------------------------------- + # Phase 6: help + #---------------------------------------------------- + + proc Help {topic {x 0} {y 0}} { + global helpTopics helpCmds + if {$topic == ""} return + while {[info exists helpCmds($topic)]} { + set topic [eval $helpCmds($topic)] + } + if [info exists helpTopics($topic)] { + set msg $helpTopics($topic) + } else { + set msg "Sorry, but no help is available for this topic" + } + tk_dialog .help {Rolodex Help} "Information on $topic:\n\n$msg" \ + {} 0 OK + } + + proc getMenuTopic {w x y} { + return $w.[$w index @[expr $y-[winfo rooty $w]]] + } + + bind . {Help [winfo containing %X %Y] %X %Y} + bind . {Help [winfo containing %X %Y] %X %Y} + + # Help text and commands follow: + + set helpTopics(.menu.file) {This is the "file" menu. It can be used to invoke some overall operations on the rolodex applications, such as loading a file or exiting.} + + set helpCmds(.menu.file.m) {getMenuTopic $topic $x $y} + set helpTopics(.menu.file.m.0) {The "Load" entry in the "File" menu posts a dialog box that you can use to select a rolodex file} + set helpTopics(.menu.file.m.1) {The "Exit" entry in the "File" menu causes the rolodex application to terminate} + set helpCmds(.menu.file.m.none) {set topic ".menu.file"} + + set helpTopics(.frame.1.entry) {In this field of the rolodex entry you should type the person's name} + set helpTopics(.frame.2.entry) {In this field of the rolodex entry you should type the first line of the person's address} + set helpTopics(.frame.3.entry) {In this field of the rolodex entry you should type the second line of the person's address} + set helpTopics(.frame.4.entry) {In this field of the rolodex entry you should type the third line of the person's address} + set helpTopics(.frame.5.entry) {In this field of the rolodex entry you should type the person's home phone number, or "private" if the person doesn't want his or her number publicized} + set helpTopics(.frame.6.entry) {In this field of the rolodex entry you should type the person's work phone number} + set helpTopics(.frame.7.entry) {In this field of the rolodex entry you should type the phone number for the person's FAX machine} + + set helpCmds(.frame.1.label) {set topic .frame.1.entry} + set helpCmds(.frame.2.label) {set topic .frame.2.entry} + set helpCmds(.frame.3.label) {set topic .frame.3.entry} + set helpCmds(.frame.4.label) {set topic .frame.4.entry} + set helpCmds(.frame.5.label) {set topic .frame.5.entry} + set helpCmds(.frame.6.label) {set topic .frame.6.entry} + set helpCmds(.frame.7.label) {set topic .frame.7.entry} + + set helpTopics(context) {Unfortunately, this application doesn't support context-sensitive help in the usual way, because when this demo was written Tk didn't have a grab mechanism and this is needed for context-sensitive help. Instead, you can achieve much the same effect by simply moving the mouse over the window you're curious about and pressing the Help or F1 keys. You can do this anytime.} + set helpTopics(help) {This application provides only very crude help. Besides the entries in this menu, you can get help on individual windows by moving the mouse cursor over the window and pressing the Help or F1 keys.} + set helpTopics(window) {This window is a dummy rolodex application created as part of Tom LaStrange's toolkit benchmark. It doesn't really do anything useful except to demonstrate a few features of the Tk toolkit.} + set helpTopics(keys) "The following accelerator keys are defined for this application (in addition to those already available for the entry windows):\n\nCtrl+A:\t\tAdd\nCtrl+C:\t\tClear\nCtrl+D:\t\tDelete\nCtrl+F:\t\tEnter file name\nCtrl+Q:\t\tExit application (quit)\nCtrl+S:\t\tSearch (dummy operation)" + set helpTopics(version) {This is version 1.0.} + + # Entries in "Help" menu + + .menu.help.m add command -label "On Context..." -command {Help context} \ + -underline 3 + .menu.help.m add command -label "On Help..." -command {Help help} \ + -underline 3 + .menu.help.m add command -label "On Window..." -command {Help window} \ + -underline 3 + .menu.help.m add command -label "On Keys..." -command {Help keys} \ + -underline 3 + .menu.help.m add command -label "On Version..." -command {Help version} \ + -underline 3 diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/ruler.tcl ./library/demos.jp/ruler.tcl *** ../tk4.2/library/demos.jp/ruler.tcl Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/ruler.tcl Sun Nov 24 18:25:55 1996 *************** *** 0 **** --- 1,169 ---- + # ruler.tcl -- + # + # This demonstration script creates a canvas widget that displays a ruler + # with tab stops that can be set, moved, and deleted. + # + # SCCS: @(#) ruler.tcl 1.8 96/04/12 12:12:27 + + # rulerMkTab -- + # This procedure creates a new triangular polygon in a canvas to + # represent a tab stop. + # + # Arguments: + # c - The canvas window. + # x, y - Coordinates at which to create the tab stop. + + proc rulerMkTab {c x y} { + upvar #0 demo_rulerInfo v + $c create polygon $x $y [expr $x+$v(size)] [expr $y+$v(size)] \ + [expr $x-$v(size)] [expr $y+$v(size)] + } + + set w .ruler + global tk_library + catch {destroy $w} + toplevel $w + wm title $w "Ruler Demonstration" + wm iconname $w "ruler" + positionWindow $w + set c $w.c + + label $w.msg -font $font -wraplength 5i -justify left -text "このキャンバス widget はルーラーの模型です。ルーラーの右にあるのはタブストップの井戸で、ここから引っ張ってくることによってタブストップを作ることができます。また、すでにあるタブストップを動かすこともできます。タブストップを上方または下方にかすれて表示されるまでドラッグすると、マウスボタンを離した時にそのタブストップは消えます。" + pack $w.msg -side top + + frame $w.buttons + pack $w.buttons -side bottom -fill x -pady 2m + button $w.buttons.dismiss -text 了解 -command "destroy $w" + button $w.buttons.code -text "コード参照" -command "showCode $w" + pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 + + canvas $c -width 14.8c -height 2.5c + pack $w.c -side top -fill x + + set demo_rulerInfo(grid) .25c + set demo_rulerInfo(left) [winfo fpixels $c 1c] + set demo_rulerInfo(right) [winfo fpixels $c 13c] + set demo_rulerInfo(top) [winfo fpixels $c 1c] + set demo_rulerInfo(bottom) [winfo fpixels $c 1.5c] + set demo_rulerInfo(size) [winfo fpixels $c .2c] + set demo_rulerInfo(normalStyle) "-fill black" + if {[winfo depth $c] > 1} { + set demo_rulerInfo(activeStyle) "-fill red -stipple {}" + set demo_rulerInfo(deleteStyle) [list -fill red \ + -stipple @[file join $tk_library demos images gray25.bmp]] + } else { + set demo_rulerInfo(activeStyle) "-fill black -stipple {}" + set demo_rulerInfo(deleteStyle) [list -fill black \ + -stipple @[file join $tk_library demos images gray25.bmp]] + } + + $c create line 1c 0.5c 1c 1c 13c 1c 13c 0.5c -width 1 + for {set i 0} {$i < 12} {incr i} { + set x [expr $i+1] + $c create line ${x}c 1c ${x}c 0.6c -width 1 + $c create line $x.25c 1c $x.25c 0.8c -width 1 + $c create line $x.5c 1c $x.5c 0.7c -width 1 + $c create line $x.75c 1c $x.75c 0.8c -width 1 + $c create text $x.15c .75c -text $i -anchor sw + } + $c addtag well withtag [$c create rect 13.2c 1c 13.8c 0.5c \ + -outline black -fill [lindex [$c config -bg] 4]] + $c addtag well withtag [rulerMkTab $c [winfo pixels $c 13.5c] \ + [winfo pixels $c .65c]] + + $c bind well <1> "rulerNewTab $c %x %y" + $c bind tab <1> "rulerSelectTab $c %x %y" + bind $c "rulerMoveTab $c %x %y" + bind $c "rulerReleaseTab $c" + + # rulerNewTab -- + # Does all the work of creating a tab stop, including creating the + # triangle object and adding tags to it to give it tab behavior. + # + # Arguments: + # c - The canvas window. + # x, y - The coordinates of the tab stop. + + proc rulerNewTab {c x y} { + upvar #0 demo_rulerInfo v + $c addtag active withtag [rulerMkTab $c $x $y] + $c addtag tab withtag active + set v(x) $x + set v(y) $y + rulerMoveTab $c $x $y + } + + # rulerSelectTab -- + # This procedure is invoked when mouse button 1 is pressed over + # a tab. It remembers information about the tab so that it can + # be dragged interactively. + # + # Arguments: + # c - The canvas widget. + # x, y - The coordinates of the mouse (identifies the point by + # which the tab was picked up for dragging). + + proc rulerSelectTab {c x y} { + upvar #0 demo_rulerInfo v + set v(x) [$c canvasx $x $v(grid)] + set v(y) [expr $v(top)+2] + $c addtag active withtag current + eval "$c itemconf active $v(activeStyle)" + $c raise active + } + + # rulerMoveTab -- + # This procedure is invoked during mouse motion events to drag a tab. + # It adjusts the position of the tab, and changes its appearance if + # it is about to be dragged out of the ruler. + # + # Arguments: + # c - The canvas widget. + # x, y - The coordinates of the mouse. + + proc rulerMoveTab {c x y} { + upvar #0 demo_rulerInfo v + if {[$c find withtag active] == ""} { + return + } + set cx [$c canvasx $x $v(grid)] + set cy [$c canvasy $y] + if {$cx < $v(left)} { + set cx $v(left) + } + if {$cx > $v(right)} { + set cx $v(right) + } + if {($cy >= $v(top)) && ($cy <= $v(bottom))} { + set cy [expr $v(top)+2] + eval "$c itemconf active $v(activeStyle)" + } else { + set cy [expr $cy-$v(size)-2] + eval "$c itemconf active $v(deleteStyle)" + } + $c move active [expr $cx-$v(x)] [expr $cy-$v(y)] + set v(x) $cx + set v(y) $cy + } + + # rulerReleaseTab -- + # This procedure is invoked during button release events that end + # a tab drag operation. It deselects the tab and deletes the tab if + # it was dragged out of the ruler. + # + # Arguments: + # c - The canvas widget. + # x, y - The coordinates of the mouse. + + proc rulerReleaseTab c { + upvar #0 demo_rulerInfo v + if {[$c find withtag active] == {}} { + return + } + if {$v(y) != [expr $v(top)+2]} { + $c delete active + } else { + eval "$c itemconf active $v(normalStyle)" + $c dtag active + } + } diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/sayings.tcl ./library/demos.jp/sayings.tcl *** ../tk4.2/library/demos.jp/sayings.tcl Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/sayings.tcl Sun Nov 24 18:25:55 1996 *************** *** 0 **** --- 1,42 ---- + # sayings.tcl -- + # + # This demonstration script creates a listbox that can be scrolled + # both horizontally and vertically. It displays a collection of + # well-known sayings. + # + # SCCS: @(#) sayings.tcl 1.6 96/10/04 17:09:38 + + set w .sayings + catch {destroy $w} + toplevel $w + wm title $w "Listbox Demonstration (well-known sayings)" + wm iconname $w "sayings" + positionWindow $w + + label $w.msg -font $font -wraplength 4i -justify left -text "下のリストボックスにはいろいろな格言が入っています。リストをスクロールさせるのはスクロールバーでもできますし、リストボックスの中でマウスのボタン2 (中ボタン) を押したままドラッグしてもできます。" + pack $w.msg -side top + + frame $w.buttons + pack $w.buttons -side bottom -fill x -pady 2m + button $w.buttons.dismiss -text 了解 -command "destroy $w" + button $w.buttons.code -text "コード参照" -command "showCode $w" + pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 + + frame $w.frame -borderwidth 10 + pack $w.frame -side top -expand yes -fill y + + + scrollbar $w.frame.yscroll -command "$w.frame.list yview" + scrollbar $w.frame.xscroll -orient horizontal \ + -command "$w.frame.list xview" + listbox $w.frame.list -width 20 -height 10 -setgrid 1 \ + -yscroll "$w.frame.yscroll set" -xscroll "$w.frame.xscroll set" + + grid $w.frame.list -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news + grid $w.frame.yscroll -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news + grid $w.frame.xscroll -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news + grid rowconfig $w.frame 0 -weight 1 -minsize 0 + grid columnconfig $w.frame 0 -weight 1 -minsize 0 + + + $w.frame.list insert 0 "Waste not, want not" "Early to bed and early to rise makes a man healthy, wealthy, and wise" "Ask not what your country can do for you, ask what you can do for your country" "I shall return" "NOT" "A picture is worth a thousand words" "User interfaces are hard to build" "Thou shalt not steal" "A penny for your thoughts" "Fool me once, shame on you; fool me twice, shame on me" "Every cloud has a silver lining" "Where there's smoke there's fire" "It takes one to know one" "Curiosity killed the cat" "Take this job and shove it" "Up a creek without a paddle" "I'm mad as hell and I'm not going to take it any more" "An apple a day keeps the doctor away" "Don't look a gift horse in the mouth" diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/search.tcl ./library/demos.jp/search.tcl *** ../tk4.2/library/demos.jp/search.tcl Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/search.tcl Sun Nov 24 18:25:55 1996 *************** *** 0 **** --- 1,137 ---- + # search.tcl -- + # + # This demonstration script creates a collection of widgets that + # allow you to load a file into a text widget, then perform searches + # on that file. + # + # SCCS: @(#) search.tcl 1.4 96/02/16 10:49:12 + + # textLoadFile -- + # This procedure below loads a file into a text widget, discarding + # the previous contents of the widget. Tags for the old widget are + # not affected, however. + # + # Arguments: + # w - The window into which to load the file. Must be a + # text widget. + # file - The name of the file to load. Must be readable. + + proc textLoadFile {w file} { + set f [open $file] + $w delete 1.0 end + while {![eof $f]} { + $w insert end [read $f 10000] + } + close $f + } + + # textSearch -- + # Search for all instances of a given string in a text widget and + # apply a given tag to each instance found. + # + # Arguments: + # w - The window in which to search. Must be a text widget. + # string - The string to search for. The search is done using + # exact matching only; no special characters. + # tag - Tag to apply to each instance of a matching string. + + proc textSearch {w string tag} { + $w tag remove search 0.0 end + if {$string == ""} { + return + } + set cur 1.0 + while 1 { + set cur [$w search -count length $string $cur end] + if {$cur == ""} { + break + } + $w tag add $tag $cur "$cur + $length char" + set cur [$w index "$cur + $length char"] + } + } + + # textToggle -- + # This procedure is invoked repeatedly to invoke two commands at + # periodic intervals. It normally reschedules itself after each + # execution but if an error occurs (e.g. because the window was + # deleted) then it doesn't reschedule itself. + # + # Arguments: + # cmd1 - Command to execute when procedure is called. + # sleep1 - Ms to sleep after executing cmd1 before executing cmd2. + # cmd2 - Command to execute in the *next* invocation of this + # procedure. + # sleep2 - Ms to sleep after executing cmd2 before executing cmd1 again. + + proc textToggle {cmd1 sleep1 cmd2 sleep2} { + catch { + eval $cmd1 + after $sleep1 [list textToggle $cmd2 $sleep2 $cmd1 $sleep1] + } + } + + set w .search + catch {destroy $w} + toplevel $w + wm title $w "Text Demonstration - Search and Highlight" + wm iconname $w "search" + positionWindow $w + + frame $w.buttons + pack $w.buttons -side bottom -fill x -pady 2m + button $w.buttons.dismiss -text 了解 -command "destroy $w" + button $w.buttons.code -text "コード参照" -command "showCode $w" + pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 + + frame $w.file + label $w.file.label -text "ファイル名:" -width 13 -anchor w + entry $w.file.entry -width 40 -textvariable fileName + button $w.file.button -text "読み込み" \ + -command "textLoadFile $w.text \$fileName" + pack $w.file.label $w.file.entry -side left + pack $w.file.button -side left -pady 5 -padx 10 + bind $w.file.entry " + textLoadFile $w.text \$fileName + focus $w.string.entry + " + focus $w.file.entry + + frame $w.string + label $w.string.label -text "検索文字列:" -width 13 -anchor w + entry $w.string.entry -width 40 -textvariable searchString + button $w.string.button -text "反転" \ + -command "textSearch $w.text \$searchString search" + pack $w.string.label $w.string.entry -side left + pack $w.string.button -side left -pady 5 -padx 10 + bind $w.string.entry "textSearch $w.text \$searchString search" + + text $w.text -yscrollcommand "$w.scroll set" -setgrid true + scrollbar $w.scroll -command "$w.text yview" + pack $w.file $w.string -side top -fill x + pack $w.scroll -side right -fill y + pack $w.text -expand yes -fill both + + # Set up display styles for text highlighting. + + if {[winfo depth $w] > 1} { + textToggle "$w.text tag configure search -background \ + #ce5555 -foreground white" 800 "$w.text tag configure \ + search -background {} -foreground {}" 200 + } else { + textToggle "$w.text tag configure search -background \ + black -foreground white" 800 "$w.text tag configure \ + search -background {} -foreground {}" 200 + } + $w.text insert 1.0 \ + {このウィンドウは検索機構を実現するのにテキスト widget のタグ機能がどの + ように使われるのかをデモするものです。まず上のエントリにファイル名を入 + れ、<リターン> を押すか「ロード」ボタンを押してください。次にその下の + エントリに文字列を入力し、<リターン> を押すか「反転」ボタンを押してく + ださい。するとファイル中の、検索文字列と一致する部分に全て "search" + というタグがつけられ、タグの表示属性としてその文字列が点滅するように + 設定されます。} + $w.text mark set insert 0.0 + + set fileName "" + set searchString "" diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/square ./library/demos.jp/square *** ../tk4.2/library/demos.jp/square Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/square Sun Nov 24 18:25:55 1996 *************** *** 0 **** --- 1,55 ---- + #!/bin/sh + # the next line restarts using wish \ + exec wish "$0" "$@" + + # square -- + # This script generates a demo application containing only + # a "square" widget. It's only usable if Tk has been compiled + # with tkSquare.c and with the -DSQUARE_DEMO compiler switch. + # This demo arranges the following bindings for the widget: + # + # Button-1 press/drag: moves square to mouse + # "a": toggle size animation on/off + # + # SCCS: @(#) square 1.6 96/02/16 10:49:21 + + square .s + pack .s -expand yes -fill both + wm minsize . 1 1 + + bind .s <1> {center %x %y} + bind .s {center %x %y} + bind .s a animate + focus .s + + # The procedure below centers the square on a given position. + + proc center {x y} { + set a [.s size] + .s position [expr $x-($a/2)] [expr $y-($a/2)] + } + + # The procedures below provide a simple form of animation where + # the box changes size in a pulsing pattern: larger, smaller, larger, + # and so on. + + set inc 0 + proc animate {} { + global inc + if {$inc == 0} { + set inc 3 + timer + } else { + set inc 0 + } + } + + proc timer {} { + global inc + set s [.s size] + if {$inc == 0} return + if {$s >= 40} {set inc -3} + if {$s <= 10} {set inc 3} + .s size [expr {$s+$inc}] + after 30 timer + } diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/states.tcl ./library/demos.jp/states.tcl *** ../tk4.2/library/demos.jp/states.tcl Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/states.tcl Sun Nov 24 18:25:55 1996 *************** *** 0 **** --- 1,42 ---- + # states.tcl -- + # + # This demonstration script creates a listbox widget that displays + # the names of the 50 states in the United States of America. + # + # SCCS: @(#) states.tcl 1.3 96/02/16 10:49:50 + + set w .states + catch {destroy $w} + toplevel $w + wm title $w "Listbox Demonstration (50 states)" + wm iconname $w "states" + positionWindow $w + + label $w.msg -font $font -wraplength 4i -justify left -text "下にあるのは都道府県名が入ったスクロールバー付のリストボックスです。リストをスクロールさせるのはスクロールバーでもできますし、リストボックスの中でマウスのボタン2 (中ボタン) を押したままドラッグしてもできます。" + pack $w.msg -side top + + frame $w.buttons + pack $w.buttons -side bottom -fill x -pady 2m + button $w.buttons.dismiss -text 了解 -command "destroy $w" + button $w.buttons.code -text "コード参照" -command "showCode $w" + pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 + + frame $w.frame -borderwidth .5c + pack $w.frame -side top -expand yes -fill y + + scrollbar $w.frame.scroll -command "$w.frame.list yview" + listbox $w.frame.list -yscroll "$w.frame.scroll set" -setgrid 1 -height 12 + pack $w.frame.scroll -side right -fill y + pack $w.frame.list -side left -expand 1 -fill both + + $w.frame.list insert 0 \ + 愛知 青森 秋田 石川 茨城 \ + 岩手 愛媛 大分 大阪 岡山 \ + 沖縄 香川 鹿児島 神奈川 岐阜 \ + 京都 熊本 群馬 高知 埼玉 \ + 佐賀 滋賀 静岡 島根 千葉 \ + 東京 徳島 栃木 鳥取 富山 \ + 長崎 長野 奈良 新潟 兵庫 \ + 広島 福井 福岡 福島 北海道 \ + 三重 宮城 宮崎 山形 山口 \ + 山梨 和歌山 diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/style.tcl ./library/demos.jp/style.tcl *** ../tk4.2/library/demos.jp/style.tcl Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/style.tcl Sun Nov 24 18:25:55 1996 *************** *** 0 **** --- 1,182 ---- + # style.tcl -- + # + # This demonstration script creates a text widget that illustrates the + # various display styles that may be set for tags. + # + # SCCS: @(#) style.tcl 1.5 96/02/16 10:49:24 + + set w .style + catch {destroy $w} + toplevel $w + wm title $w "Text Demonstration - Display Styles" + wm iconname $w "style" + positionWindow $w + + frame $w.buttons + pack $w.buttons -side bottom -fill x -pady 2m + button $w.buttons.dismiss -text 了解 -command "destroy $w" + button $w.buttons.code -text "コード参照" -command "showCode $w" + pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 + + text $w.text -yscrollcommand "$w.scroll set" -setgrid true \ + -width 70 -height 32 -wrap word + scrollbar $w.scroll -command "$w.text yview" + pack $w.scroll -side right -fill y + pack $w.text -expand yes -fill both + + # Set up display styles + + $w.text tag configure bold -font -*-Courier-Bold-O-Normal--*-120-*-*-*-*-*-* + $w.text tag configure big -font -*-Courier-Bold-R-Normal--*-140-*-*-*-*-*-* + $w.text tag configure verybig -font \ + -*-Helvetica-Bold-R-Normal--*-240-*-*-*-*-*-* + if {[winfo depth $w] > 1} { + $w.text tag configure color1 -background #a0b7ce + $w.text tag configure color2 -foreground red + $w.text tag configure raised -relief raised -borderwidth 1 + $w.text tag configure sunken -relief sunken -borderwidth 1 + } else { + $w.text tag configure color1 -background black -foreground white + $w.text tag configure color2 -background black -foreground white + $w.text tag configure raised -background white -relief raised \ + -borderwidth 1 + $w.text tag configure sunken -background white -relief sunken \ + -borderwidth 1 + } + $w.text tag configure bgstipple -background black -borderwidth 0 \ + -bgstipple gray12 + $w.text tag configure fgstipple -fgstipple gray50 + $w.text tag configure underline -underline on + $w.text tag configure overstrike -overstrike on + $w.text tag configure right -justify right + $w.text tag configure center -justify center + $w.text tag configure super -offset 4p \ + -font -Adobe-Courier-Medium-R-Normal--*-100-*-*-*-*-*-* + $w.text tag configure sub -offset -2p \ + -font -Adobe-Courier-Medium-R-Normal--*-100-*-*-*-*-*-* + $w.text tag configure margins -lmargin1 12m -lmargin2 6m -rmargin 10m + $w.text tag configure spacing -spacing1 10p -spacing2 2p \ + -lmargin1 12m -lmargin2 6m -rmargin 10m + + $w.text insert end {このようにテキスト widget は情報を様々なスタイルで表示すること + ができます。} + $w.text insert end タグ big + $w.text insert end {というメカニズムでコントロールされます。 + タグとはテキスト widget 内のある文字 (の範囲)に対して適用できる + 単なる名前のことです。タグは様々な表示スタイルに設定できます。 + 設定すると、そのタグのついた文字は指定したスタイルで表示される + ようになります。使用できる表示スタイルは次の通りです。 + } + $w.text insert end { + 1. フォント} big + $w.text insert end { どんな X のフォントでも使えます。} + $w.text insert end large verybig + $w.text insert end { + とか} + $w.text insert end small small + $w.text insert end {とか。 + } + $w.text insert end { + 2. 色} big + $w.text insert end { } + $w.text insert end {背景色} color1 + $w.text insert end {も} + $w.text insert end {前景色} color2 + $w.text insert end {も} + $w.text insert end {両方} {color1 color2} + $w.text insert end {とも変えることができます。 + } + $w.text insert end { + 3. 網かけ} big + $w.text insert end { このように描画の際に} + $w.text insert end {背景も} bgstipple + $w.text insert end {文字も} fgstipple + $w.text insert end {単なる塗りつぶし + でなく、網かけを使うことができます。 + } + $w.text insert end { + 4. 下線} big + $w.text insert end { このように} + $w.text insert end {文字に下線を引く} underline + $w.text insert end {ことができます。 + } + $w.text insert end { + 5. 打ち消し線} big + $w.text insert end { このように} + $w.text insert end {文字に重ねて線を引く} overstrike + $w.text insert end {ことができます。 + } + $w.text insert end { + 6. 3D 効果} big + $w.text insert end { 背景に枠をつけて、文字を} + $w.text insert end {飛び出す} raised + $w.text insert end {ようにしたり} + $w.text insert end {沈む} sunken + $w.text insert end { + ようにできます。 + } + $w.text insert end { + 7. 行揃え} big + $w.text insert end { このように行を + } + $w.text insert end {左に揃えたり + } + $w.text insert end {右に揃えたり, + } right + $w.text insert end {真中に揃えたりできます。 + } center + $w.text insert end { + 8. 肩付き文字と添字} big + $w.text insert end { 10} + $w.text insert end {n} super + $w.text insert end { のように肩付き文字の効果や、} + $w.text insert end { + X} + $w.text insert end {i} sub + $w.text insert end {のように添字の効果を出すことができます。 + } + $w.text insert end { + 9. マージン} big + $w.text insert end {テキストの左側に余分な空白を} + $w.text insert end {置くことができます: + } + $w.text insert end {この段落はマージンの使用例です。スクリーン} margins + $w.text insert end {上で折り返されて表示されている1行のテキストです。} margins + $w.text insert end {左側には2種類のマージンを持ちます。} margins + $w.text insert end {1行目に対するものと、} margins + $w.text insert end {2行目以降の連続したマージン} margins + $w.text insert end {です。また右側にもマージンがあります。} margins + $w.text insert end {行の折り返し位置を決めるために使用することができます。 + } margins + $w.text insert end { + 10. スペーシング} big + $w.text insert end {3つのパラメータで行のスペーシングを} + $w.text insert end {制御す + ることができます。Spacing1で、行の} + $w.text insert end {上にどのくらいの空間を置くか、 + spacing3} + $w.text insert end {で行の下にどのくらいの空間を置くか、} + $w.text insert end {行が折り返されているなら + ば、spacing2で、} + $w.text insert end {テキスト行を生成している行の間にどのくらい} + $w.text insert end {の空間を置 + くかを示します。 + } + $w.text insert end {これらのインデントされた段落はどのように} spacing + $w.text insert end {スペーシングがが行われるのかを示します。} spacing + $w.text insert end {各段落は実際はテキストwidget} spacing + $w.text insert end {の1行で、widgetによって折り畳まれています。 + } spacing + $w.text insert end {Spacing1はこのテキストでは10pointに} spacing + $w.text insert end {設定されています。} spacing + $w.text insert end {これにより、段落の間に大きな間隔が} spacing + $w.text insert end {存在しています。} spacing + $w.text insert end {Spacing2は2pointに設定されています。} spacing + $w.text insert end {これで段落の中にほんの少し間隔が存在しています。} spacing + $w.text insert end {Spacing3はこの例では使用されていません。 + } spacing + $w.text insert end {間隔がどこにあるかを見たければ、これらの段落の} spacing + $w.text insert end {なかでテキストを選択してください。選択の} spacing + $w.text insert end {反転した部分には余分にとられた間隔が} spacing + $w.text insert end {含まれています。 + } spacing diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/tclIndex ./library/demos.jp/tclIndex *** ../tk4.2/library/demos.jp/tclIndex Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/tclIndex Sun Nov 24 18:25:55 1996 *************** *** 0 **** --- 1,67 ---- + # Tcl autoload index file, version 2.0 + # This file is generated by the "auto_mkindex" command + # and sourced to set up indexing information for one or + # more commands. Typically each line is a command that + # sets an element in the auto_index array, where the + # element name is the name of a command and the value is + # a script that loads the command. + + set auto_index(arrowSetup) [list source [file join $dir arrow.tcl]] + set auto_index(arrowMove1) [list source [file join $dir arrow.tcl]] + set auto_index(arrowMove2) [list source [file join $dir arrow.tcl]] + set auto_index(arrowMove3) [list source [file join $dir arrow.tcl]] + set auto_index(textLoadFile) [list source [file join $dir search.tcl]] + set auto_index(textSearch) [list source [file join $dir search.tcl]] + set auto_index(textToggle) [list source [file join $dir search.tcl]] + set auto_index(itemEnter) [list source [file join $dir items.tcl]] + set auto_index(itemLeave) [list source [file join $dir items.tcl]] + set auto_index(itemMark) [list source [file join $dir items.tcl]] + set auto_index(itemStroke) [list source [file join $dir items.tcl]] + set auto_index(itemsUnderArea) [list source [file join $dir items.tcl]] + set auto_index(itemStartDrag) [list source [file join $dir items.tcl]] + set auto_index(itemDrag) [list source [file join $dir items.tcl]] + set auto_index(butPress) [list source [file join $dir items.tcl]] + set auto_index(loadDir) [list source [file join $dir image2.tcl]] + set auto_index(loadImage) [list source [file join $dir image2.tcl]] + set auto_index(rulerMkTab) [list source [file join $dir ruler.tcl]] + set auto_index(rulerNewTab) [list source [file join $dir ruler.tcl]] + set auto_index(rulerSelectTab) [list source [file join $dir ruler.tcl]] + set auto_index(rulerMoveTab) [list source [file join $dir ruler.tcl]] + set auto_index(rulerReleaseTab) [list source [file join $dir ruler.tcl]] + set auto_index(mkTextConfig) [list source [file join $dir ctext.tcl]] + set auto_index(textEnter) [list source [file join $dir ctext.tcl]] + set auto_index(textInsert) [list source [file join $dir ctext.tcl]] + set auto_index(textPaste) [list source [file join $dir ctext.tcl]] + set auto_index(textB1Press) [list source [file join $dir ctext.tcl]] + set auto_index(textB1Move) [list source [file join $dir ctext.tcl]] + set auto_index(textBs) [list source [file join $dir ctext.tcl]] + set auto_index(textDel) [list source [file join $dir ctext.tcl]] + set auto_index(bitmapRow) [list source [file join $dir bitmap.tcl]] + set auto_index(scrollEnter) [list source [file join $dir cscroll.tcl]] + set auto_index(scrollLeave) [list source [file join $dir cscroll.tcl]] + set auto_index(scrollButton) [list source [file join $dir cscroll.tcl]] + set auto_index(textWindOn) [list source [file join $dir twind.tcl]] + set auto_index(textWindOff) [list source [file join $dir twind.tcl]] + set auto_index(textWindPlot) [list source [file join $dir twind.tcl]] + set auto_index(embPlotDown) [list source [file join $dir twind.tcl]] + set auto_index(embPlotMove) [list source [file join $dir twind.tcl]] + set auto_index(textWindDel) [list source [file join $dir twind.tcl]] + set auto_index(embDefBg) [list source [file join $dir twind.tcl]] + set auto_index(floorDisplay) [list source [file join $dir floor.tcl]] + set auto_index(newRoom) [list source [file join $dir floor.tcl]] + set auto_index(roomChanged) [list source [file join $dir floor.tcl]] + set auto_index(bg1) [list source [file join $dir floor.tcl]] + set auto_index(bg2) [list source [file join $dir floor.tcl]] + set auto_index(bg3) [list source [file join $dir floor.tcl]] + set auto_index(fg1) [list source [file join $dir floor.tcl]] + set auto_index(fg2) [list source [file join $dir floor.tcl]] + set auto_index(fg3) [list source [file join $dir floor.tcl]] + set auto_index(setWidth) [list source [file join $dir hscale.tcl]] + set auto_index(plotDown) [list source [file join $dir plot.tcl]] + set auto_index(plotMove) [list source [file join $dir plot.tcl]] + set auto_index(puzzleSwitch) [list source [file join $dir puzzle.tcl]] + set auto_index(setHeight) [list source [file join $dir vscale.tcl]] + set auto_index(showMessageBox) [list source [file join $dir msgbox.tcl]] + set auto_index(setColor) [list source [file join $dir clrpick.tcl]] + set auto_index(setColor_helper) [list source [file join $dir clrpick.tcl]] + set auto_index(fileDialog) [list source [file join $dir filebox.tcl]] diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/tcolor ./library/demos.jp/tcolor *** ../tk4.2/library/demos.jp/tcolor Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/tcolor Sun Nov 24 18:25:55 1996 *************** *** 0 **** --- 1,359 ---- + #!/bin/sh + # the next line restarts using wish \ + exec wish "$0" "$@" + + # tcolor -- + # This script implements a simple color editor, where you can + # create colors using either the RGB, HSB, or CYM color spaces + # and apply the color to existing applications. + # + # SCCS: @(#) tcolor 1.10 96/02/16 10:49:25 + + wm title . "Color Editor" + + # Global variables that control the program: + # + # colorSpace - Color space currently being used for + # editing. Must be "rgb", "cmy", or "hsb". + # label1, label2, label3 - Labels for the scales. + # red, green, blue - Current color intensities in decimal + # on a scale of 0-65535. + # color - A string giving the current color value + # in the proper form for x: + # #RRRRGGGGBBBB + # updating - Non-zero means that we're in the middle of + # updating the scales to load a new color,so + # information shouldn't be propagating back + # from the scales to other elements of the + # program: this would make an infinite loop. + # command - Holds the command that has been typed + # into the "Command" entry. + # autoUpdate - 1 means execute the update command + # automatically whenever the color changes. + # name - Name for new color, typed into entry. + + set colorSpace hsb + set red 65535 + set green 0 + set blue 0 + set color #ffff00000000 + set updating 0 + set autoUpdate 1 + set name "" + + # Create the menu bar at the top of the window. + + frame .menu -relief raised -borderwidth 2 + pack .menu -side top -fill x + menubutton .menu.file -text File -menu .menu.file.m -underline 0 + menu .menu.file.m + .menu.file.m add radio -label "RGB color space" -variable colorSpace \ + -value rgb -underline 0 -command {changeColorSpace rgb} + .menu.file.m add radio -label "CMY color space" -variable colorSpace \ + -value cmy -underline 0 -command {changeColorSpace cmy} + .menu.file.m add radio -label "HSB color space" -variable colorSpace \ + -value hsb -underline 0 -command {changeColorSpace hsb} + .menu.file.m add separator + .menu.file.m add radio -label "Automatic updates" -variable autoUpdate \ + -value 1 -underline 0 + .menu.file.m add radio -label "Manual updates" -variable autoUpdate \ + -value 0 -underline 0 + .menu.file.m add separator + .menu.file.m add command -label "Exit program" -underline 0 \ + -command "destroy ." + pack .menu.file -side left + + # Create the command entry window at the bottom of the window, along + # with the update button. + + frame .bot -relief raised -borderwidth 2 + pack .bot -side bottom -fill x + label .commandLabel -text "Command:" + entry .command -relief sunken -borderwidth 2 -textvariable command \ + -font -Adobe-Courier-Medium-R-Normal--*-120-*-*-*-*-*-* + button .update -text Update -command doUpdate + pack .commandLabel -in .bot -side left + pack .update -in .bot -side right -pady .1c -padx .25c + pack .command -in .bot -expand yes -fill x -ipadx 0.25c + + # Create the listbox that holds all of the color names in rgb.txt, + # if an rgb.txt file can be found. + + frame .middle -relief raised -borderwidth 2 + pack .middle -side top -fill both + foreach i {/usr/local/lib/X11/rgb.txt /usr/lib/X11/rgb.txt + /X11/R5/lib/X11/rgb.txt /X11/R4/lib/rgb/rgb.txt + /usr/openwin/lib/X11/rgb.txt} { + if ![file readable $i] { + continue; + } + set f [open $i] + frame .middle.left + pack .middle.left -side left -padx .25c -pady .25c + listbox .names -width 20 -height 12 -yscrollcommand ".scroll set" \ + -relief sunken -borderwidth 2 -exportselection false + bind .names { + tc_loadNamedColor [.names get [.names curselection]] + } + scrollbar .scroll -orient vertical -command ".names yview" \ + -relief sunken -borderwidth 2 + pack .names -in .middle.left -side left + pack .scroll -in .middle.left -side right -fill y + while {[gets $f line] >= 0} { + if {[llength $line] == 4} { + .names insert end [lindex $line 3] + } + } + close $f + break + } + + # Create the three scales for editing the color, and the entry for + # typing in a color value. + + frame .middle.middle + pack .middle.middle -side left -expand yes -fill y + frame .middle.middle.1 + frame .middle.middle.2 + frame .middle.middle.3 + frame .middle.middle.4 + pack .middle.middle.1 .middle.middle.2 .middle.middle.3 -side top -expand yes + pack .middle.middle.4 -side top -expand yes -fill x + foreach i {1 2 3} { + label .label$i -textvariable label$i + scale .scale$i -from 0 -to 1000 -length 6c -orient horizontal \ + -command tc_scaleChanged + pack .scale$i .label$i -in .middle.middle.$i -side top -anchor w + } + label .nameLabel -text "Name:" + entry .name -relief sunken -borderwidth 2 -textvariable name -width 10 \ + -font -Adobe-Courier-Medium-R-Normal--*-120-*-*-*-*-*-* + pack .nameLabel -in .middle.middle.4 -side left + pack .name -in .middle.middle.4 -side right -expand 1 -fill x + bind .name {tc_loadNamedColor $name} + + # Create the color display swatch on the right side of the window. + + frame .middle.right + pack .middle.right -side left -pady .25c -padx .25c -anchor s + frame .swatch -width 2c -height 5c -background $color + label .value -textvariable color -width 13 \ + -font -Adobe-Courier-Medium-R-Normal--*-120-*-*-*-*-*-* + pack .swatch -in .middle.right -side top -expand yes -fill both + pack .value -in .middle.right -side bottom -pady .25c + + # The procedure below is invoked when one of the scales is adjusted. + # It propagates color information from the current scale readings + # to everywhere else that it is used. + + proc tc_scaleChanged args { + global red green blue colorSpace color updating autoUpdate + if $updating { + return + } + if {$colorSpace == "rgb"} { + set red [format %.0f [expr [.scale1 get]*65.535]] + set green [format %.0f [expr [.scale2 get]*65.535]] + set blue [format %.0f [expr [.scale3 get]*65.535]] + } else { + if {$colorSpace == "cmy"} { + set red [format %.0f [expr {65535 - [.scale1 get]*65.535}]] + set green [format %.0f [expr {65535 - [.scale2 get]*65.535}]] + set blue [format %.0f [expr {65535 - [.scale3 get]*65.535}]] + } else { + set list [hsbToRgb [expr {[.scale1 get]/1000.0}] \ + [expr {[.scale2 get]/1000.0}] \ + [expr {[.scale3 get]/1000.0}]] + set red [lindex $list 0] + set green [lindex $list 1] + set blue [lindex $list 2] + } + } + set color [format "#%04x%04x%04x" $red $green $blue] + .swatch config -bg $color + if $autoUpdate doUpdate + update idletasks + } + + # The procedure below is invoked to update the scales from the + # current red, green, and blue intensities. It's invoked after + # a change in the color space and after a named color value has + # been loaded. + + proc tc_setScales {} { + global red green blue colorSpace updating + set updating 1 + if {$colorSpace == "rgb"} { + .scale1 set [format %.0f [expr $red/65.535]] + .scale2 set [format %.0f [expr $green/65.535]] + .scale3 set [format %.0f [expr $blue/65.535]] + } else { + if {$colorSpace == "cmy"} { + .scale1 set [format %.0f [expr (65535-$red)/65.535]] + .scale2 set [format %.0f [expr (65535-$green)/65.535]] + .scale3 set [format %.0f [expr (65535-$blue)/65.535]] + } else { + set list [rgbToHsv $red $green $blue] + .scale1 set [format %.0f [expr {[lindex $list 0] * 1000.0}]] + .scale2 set [format %.0f [expr {[lindex $list 1] * 1000.0}]] + .scale3 set [format %.0f [expr {[lindex $list 2] * 1000.0}]] + } + } + set updating 0 + } + + # The procedure below is invoked when a named color has been + # selected from the listbox or typed into the entry. It loads + # the color into the editor. + + proc tc_loadNamedColor name { + global red green blue color autoUpdate + + if {[string index $name 0] != "#"} { + set list [winfo rgb .swatch $name] + set red [lindex $list 0] + set green [lindex $list 1] + set blue [lindex $list 2] + } else { + case [string length $name] { + 4 {set format "#%1x%1x%1x"; set shift 12} + 7 {set format "#%2x%2x%2x"; set shift 8} + 10 {set format "#%3x%3x%3x"; set shift 4} + 13 {set format "#%4x%4x%4x"; set shift 0} + default {error "syntax error in color name \"$name\""} + } + if {[scan $name $format red green blue] != 3} { + error "syntax error in color name \"$name\"" + } + set red [expr $red<<$shift] + set green [expr $green<<$shift] + set blue [expr $blue<<$shift] + } + tc_setScales + set color [format "#%04x%04x%04x" $red $green $blue] + .swatch config -bg $color + if $autoUpdate doUpdate + } + + # The procedure below is invoked when a new color space is selected. + # It changes the labels on the scales and re-loads the scales with + # the appropriate values for the current color in the new color space + + proc changeColorSpace space { + global label1 label2 label3 + if {$space == "rgb"} { + set label1 Red + set label2 Green + set label3 Blue + tc_setScales + return + } + if {$space == "cmy"} { + set label1 Cyan + set label2 Magenta + set label3 Yellow + tc_setScales + return + } + if {$space == "hsb"} { + set label1 Hue + set label2 Saturation + set label3 Brightness + tc_setScales + return + } + } + + # The procedure below converts an RGB value to HSB. It takes red, green, + # and blue components (0-65535) as arguments, and returns a list containing + # HSB components (floating-point, 0-1) as result. The code here is a copy + # of the code on page 615 of "Fundamentals of Interactive Computer Graphics" + # by Foley and Van Dam. + + proc rgbToHsv {red green blue} { + if {$red > $green} { + set max $red.0 + set min $green.0 + } else { + set max $green.0 + set min $red.0 + } + if {$blue > $max} { + set max $blue.0 + } else { + if {$blue < $min} { + set min $blue.0 + } + } + set range [expr $max-$min] + if {$max == 0} { + set sat 0 + } else { + set sat [expr {($max-$min)/$max}] + } + if {$sat == 0} { + set hue 0 + } else { + set rc [expr {($max - $red)/$range}] + set gc [expr {($max - $green)/$range}] + set bc [expr {($max - $blue)/$range}] + if {$red == $max} { + set hue [expr {.166667*($bc - $gc)}] + } else { + if {$green == $max} { + set hue [expr {.166667*(2 + $rc - $bc)}] + } else { + set hue [expr {.166667*(4 + $gc - $rc)}] + } + } + if {$hue < 0.0} { + set hue [expr $hue + 1.0] + } + } + return [list $hue $sat [expr {$max/65535}]] + } + + # The procedure below converts an HSB value to RGB. It takes hue, saturation, + # and value components (floating-point, 0-1.0) as arguments, and returns a + # list containing RGB components (integers, 0-65535) as result. The code + # here is a copy of the code on page 616 of "Fundamentals of Interactive + # Computer Graphics" by Foley and Van Dam. + + proc hsbToRgb {hue sat value} { + set v [format %.0f [expr 65535.0*$value]] + if {$sat == 0} { + return "$v $v $v" + } else { + set hue [expr $hue*6.0] + if {$hue >= 6.0} { + set hue 0.0 + } + scan $hue. %d i + set f [expr $hue-$i] + set p [format %.0f [expr {65535.0*$value*(1 - $sat)}]] + set q [format %.0f [expr {65535.0*$value*(1 - ($sat*$f))}]] + set t [format %.0f [expr {65535.0*$value*(1 - ($sat*(1 - $f)))}]] + case $i \ + 0 {return "$v $t $p"} \ + 1 {return "$q $v $p"} \ + 2 {return "$p $v $t"} \ + 3 {return "$p $q $v"} \ + 4 {return "$t $p $v"} \ + 5 {return "$v $p $q"} + error "i value $i is out of range" + } + } + + # The procedure below is invoked when the "Update" button is pressed, + # and whenever the color changes if update mode is enabled. It + # propagates color information as determined by the command in the + # Command entry. + + proc doUpdate {} { + global color command + set newCmd $command + regsub -all %% $command $color newCmd + eval $newCmd + } + + changeColorSpace hsb diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/text.tcl ./library/demos.jp/text.tcl *** ../tk4.2/library/demos.jp/text.tcl Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/text.tcl Sun Nov 24 18:25:55 1996 *************** *** 0 **** --- 1,67 ---- + # text.tcl -- + # + # This demonstration script creates a text widget that describes + # the basic editing functions. + # + # SCCS: @(#) text.tcl 1.5 96/02/16 10:49:07 + + set w .text + catch {destroy $w} + toplevel $w + wm title $w "Text Demonstration - Basic Facilities" + wm iconname $w "text" + positionWindow $w + + frame $w.buttons + pack $w.buttons -side bottom -fill x -pady 2m + button $w.buttons.dismiss -text 了解 -command "destroy $w" + button $w.buttons.code -text "コード参照" -command "showCode $w" + pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 + + text $w.text -relief sunken -bd 2 -yscrollcommand "$w.scroll set" -setgrid 1 \ + -height 30 + scrollbar $w.scroll -command "$w.text yview" + pack $w.scroll -side right -fill y + pack $w.text -expand yes -fill both + $w.text insert 0.0 \ + {このウィンドウはテキスト widget です。1行またはそれ以上のテキストを表 + 示・編集することができます。以下はテキスト widget でできる操作について + まとめたものです。 + + 1. スクロール。スクロールバーでテキストの表示部分を動かすことができます。 + + 2. スキャニング。テキストのウィンドウでマウスボタン2 (中ボタンを) を押 + して上下にドラッグしてください。そうするとテキストが高速でドラッグされ、 + 内容をざっと眺めることができます。 + + 3. テキストの挿入。マウスボタン1 (左ボタン) を押し、挿入カーソルをセッ + トしてからテキストを入力してください。入力したものが widget に入ります。 + + 4. 選択。ある範囲の文字を選択するにはマウスボタン1 を押し、ドラッグし + てください。一度ボタンを離したら、シフトキーを押しながらボタン1 を押す + ことで選択範囲の調整ができます。これは選択範囲の最後をマウスカーソルに + 最も近い位置にリセットし、ボタンを離す前にマウスをドラッグすることでさ + らに選択範囲を調整できます。ダブルクリックでワードを、またトリプルクリッ + クで行全体を選択することができます。 + + 5. 消去と置換。テキストを消去するには、消去したい文字を選択してバック + スペースかデリートキーを入力してください。あるいは、新しいテキストを + 入力すると選択されたテキストと置換されます。 + + 6. 選択部分のコピー。選択部分をこのウィンドウの中のどこかにコピーする + には、まずコピーしたい所を選択(ここで、あるいは別のアプリケーションで) + し、ボタン 2 をクリックして、挿入カーソルの位置にコピーしてください。 + + 7. 編集。テキスト widget は Emacs のキーバインドに加えて標準的なの Motif + の編集機能をサポートしています。バックスペースとコントロール-H は挿入 + カーソルの左側の文字を削除します。デリートキーとコントロール-D は挿入 + カーソルの右側の文字を削除します。Meta-バックスペースは挿入カーソルの + 右側の単語を削除し、Meta-D は挿入カーソルの左側の単語を削除します。 + コントロール-K は挿入カーソルから行末までを削除し、その位置に改行 + しかなかった場合は、改行を削除します。 + + 8. ウィンドウのリサイズ。この widget は "setGrid" オプションをオンにし + てありますので、ウィンドウをリサイズする時には高さと幅は常に文字高と文 + 字幅の整数倍になります。また、ウィンドウを狭くした場合には長い行が自動 + 的に折り返され、常に全ての内容が見えるようになっています。} + $w.text mark set insert 0.0 diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/timer ./library/demos.jp/timer *** ../tk4.2/library/demos.jp/timer Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/timer Sun Nov 24 18:25:55 1996 *************** *** 0 **** --- 1,40 ---- + #!/bin/sh + # the next line restarts using wish \ + exec wish "$0" "$@" + + # timer -- + # This script generates a counter with start and stop buttons. + # + # SCCS: @(#) timer 1.6 96/02/16 10:49:20 + + label .counter -text 0.00 -relief raised -width 10 + button .start -text Start -command { + if $stopped { + set stopped 0 + tick + } + } + button .stop -text Stop -command {set stopped 1} + pack .counter -side bottom -fill both + pack .start -side left -fill both -expand yes + pack .stop -side right -fill both -expand yes + + set seconds 0 + set hundredths 0 + set stopped 1 + + proc tick {} { + global seconds hundredths stopped + if $stopped return + after 50 tick + set hundredths [expr $hundredths+5] + if {$hundredths >= 100} { + set hundredths 0 + set seconds [expr $seconds+1] + } + .counter config -text [format "%d.%02d" $seconds $hundredths] + } + + bind . {destroy .} + bind . {destroy .} + focus . diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/twind.tcl ./library/demos.jp/twind.tcl *** ../tk4.2/library/demos.jp/twind.tcl Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/twind.tcl Sun Nov 24 18:25:55 1996 *************** *** 0 **** --- 1,191 ---- + # twind.tcl -- + # + # This demonstration script creates a text widget with a bunch of + # embedded windows. + # + # SCCS: @(#) twind.tcl 1.5 96/08/20 16:04:04 + + set w .twind + catch {destroy $w} + toplevel $w + wm title $w "Text Demonstration - Embedded Windows" + wm iconname $w "Embedded Windows" + positionWindow $w + + frame $w.buttons + pack $w.buttons -side bottom -fill x -pady 2m + button $w.buttons.dismiss -text 了解 -command "destroy $w" + button $w.buttons.code -text "コード参照" -command "showCode $w" + pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 + + frame $w.f -highlightthickness 2 -borderwidth 2 -relief sunken + set t $w.f.text + text $t -yscrollcommand "$w.scroll set" -setgrid true -font $font -width 70 \ + -height 35 -wrap word -highlightthickness 0 -borderwidth 0 + pack $t -expand yes -fill both + scrollbar $w.scroll -command "$t yview" + pack $w.scroll -side right -fill y + pack $w.f -expand yes -fill both + $t tag configure center -justify center -spacing1 5m -spacing3 5m + $t tag configure buttons -lmargin1 1c -lmargin2 1c -rmargin 1c \ + -spacing1 3m -spacing2 0 -spacing3 0 + + button $t.on -text オン -command "textWindOn $w" \ + -cursor top_left_arrow + button $t.off -text オフ -command "textWindOff $w" \ + -cursor top_left_arrow + button $t.click -text ここをクリック -command "textWindPlot $t" \ + -cursor top_left_arrow + button $t.delete -text 削除 -command "textWindDel $w" \ + -cursor top_left_arrow + + $t insert end {テキストwidget上に他のwidgetを組み込むことができます。} + $t insert end {組み込みウィンドウと呼ばれ、任意のwidgetが可能です。} + $t insert end {例えば、ここに2つのボタンwidgetが組み込まれています。} + $t insert end {最初のボタンをクリックすと水平方向のスクロールを} + $t window create end -window $t.on + $t insert end {にします。また2つめのボタンをクリックすると} + $t insert end {水平方向のスクロールを} + $t window create end -window $t.off + $t insert end {にします。} + + $t insert end {もうひとつの例です。} + $t window create end -window $t.click + $t insert end {すると、x-yプロットがここに現れます。} + $t mark set plot insert + $t mark gravity plot left + $t insert end {マウスでデータを描画することができます。} + $t window create end -window $t.delete + $t insert end {をクリックすると元に戻ります。 + + } + + $t insert end {組み込みウィンドウだけをテキストwidget上に、実際の} + $t insert end {テキストはなしで組み込むことは便利です。} + $t insert end {この場合は、テキストwidgetはウィンドウマネージャの} + $t insert end {ように動作します。例えば、ここにはテキストwidgetに} + $t insert end {よってボタンがきれいに並べられています。} + $t insert end {これらのボタンで背景色を変えることができます} + $t insert end {("Default"で元の色に戻すことができます)。} + $t insert end {"Short" というボタンをクリックすると文字列の長さが変わ} + $t insert end {ります。すると自動的にテキストwidgetがレイアウト} + $t insert end {を整えてくれます。もう一度同じボタンを押すと元に戻ります。 + + } + + button $t.default -text Default -command "embDefBg $t" \ + -cursor top_left_arrow + $t window create end -window $t.default -padx 3 + global embToggle + set embToggle Short + checkbutton $t.toggle -textvariable embToggle -indicatoron 0 \ + -variable embToggle -onvalue "A much longer string" \ + -offvalue "Short" -cursor top_left_arrow -pady 5 -padx 2 + $t window create end -window $t.toggle -padx 3 -pady 2 + set i 1 + foreach color {AntiqueWhite3 Bisque1 Bisque2 Bisque3 Bisque4 + SlateBlue3 RoyalBlue1 SteelBlue2 DeepSkyBlue3 LightBlue1 + DarkSlateGray1 Aquamarine2 DarkSeaGreen2 SeaGreen1 + Yellow1 IndianRed1 IndianRed2 Tan1 Tan4} { + button $t.color$i -text $color -cursor top_left_arrow -command \ + "$t configure -bg $color" + $t window create end -window $t.color$i -padx 3 -pady 2 + incr i + } + $t tag add buttons $t.default end + + proc textWindOn w { + catch {destroy $w.scroll2} + set t $w.f.text + scrollbar $w.scroll2 -orient horizontal -command "$t xview" + pack $w.scroll2 -after $w.buttons -side bottom -fill x + $t configure -xscrollcommand "$w.scroll2 set" -wrap none + } + + proc textWindOff w { + catch {destroy $w.scroll2} + set t $w.f.text + $t configure -xscrollcommand {} -wrap word + } + + proc textWindPlot t { + set c $t.c + if [winfo exists $c] { + return + } + canvas $c -relief sunken -width 450 -height 300 -cursor top_left_arrow + + set font -Adobe-Helvetica-Medium-R-Normal--*-180-*-*-*-*-*-* + + $c create line 100 250 400 250 -width 2 + $c create line 100 250 100 50 -width 2 + $c create text 225 20 -text "A Simple Plot" -font $font -fill brown + + for {set i 0} {$i <= 10} {incr i} { + set x [expr {100 + ($i*30)}] + $c create line $x 250 $x 245 -width 2 + $c create text $x 254 -text [expr 10*$i] -anchor n -font $font + } + for {set i 0} {$i <= 5} {incr i} { + set y [expr {250 - ($i*40)}] + $c create line 100 $y 105 $y -width 2 + $c create text 96 $y -text [expr $i*50].0 -anchor e -font $font + } + + foreach point {{12 56} {20 94} {33 98} {32 120} {61 180} + {75 160} {98 223}} { + set x [expr {100 + (3*[lindex $point 0])}] + set y [expr {250 - (4*[lindex $point 1])/5}] + set item [$c create oval [expr $x-6] [expr $y-6] \ + [expr $x+6] [expr $y+6] -width 1 -outline black \ + -fill SkyBlue2] + $c addtag point withtag $item + } + + $c bind point "$c itemconfig current -fill red" + $c bind point "$c itemconfig current -fill SkyBlue2" + $c bind point <1> "embPlotDown $c %x %y" + $c bind point "$c dtag selected" + bind $c "embPlotMove $c %x %y" + while {[string first [$t get plot] " \t\n"] >= 0} { + $t delete plot + } + $t insert plot "\n" + $t window create plot -window $c + $t tag add center plot + $t insert plot "\n" + } + + set embPlot(lastX) 0 + set embPlot(lastY) 0 + + proc embPlotDown {w x y} { + global embPlot + $w dtag selected + $w addtag selected withtag current + $w raise current + set embPlot(lastX) $x + set embPlot(lastY) $y + } + + proc embPlotMove {w x y} { + global embPlot + $w move selected [expr $x-$embPlot(lastX)] [expr $y-$embPlot(lastY)] + set embPlot(lastX) $x + set embPlot(lastY) $y + } + + proc textWindDel w { + set t $w.f.text + if [winfo exists $t.c] { + $t delete $t.c + while {[string first [$t get plot] " \t\n"] >= 0} { + $t delete plot + } + $t insert plot " " + } + } + + proc embDefBg t { + $t configure -background [lindex [$t configure -background] 3] + } diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/vscale.tcl ./library/demos.jp/vscale.tcl *** ../tk4.2/library/demos.jp/vscale.tcl Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/vscale.tcl Sun Nov 24 18:25:55 1996 *************** *** 0 **** --- 1,44 ---- + # vscale.tcl -- + # + # This demonstration script shows an example with a vertical scale. + # + # SCCS: @(#) vscale.tcl 1.3 96/02/16 10:49:51 + + set w .vscale + catch {destroy $w} + toplevel $w + wm title $w "Vertical Scale Demonstration" + wm iconname $w "vscale" + positionWindow $w + + label $w.msg -font $font -wraplength 3.5i -justify left -text "下にはバーと縦型のスケールが表示されています。スケールでマウスのボタン1 をクリックするかドラッグしてバーの高さを変えることができます。終ったら「了解」ボタンを押してください。" + pack $w.msg -side top -padx .5c + + frame $w.buttons + pack $w.buttons -side bottom -fill x -pady 2m + button $w.buttons.dismiss -text 了解 -command "destroy $w" + button $w.buttons.code -text "コード参照" -command "showCode $w" + pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 + + frame $w.frame -borderwidth 10 + pack $w.frame + + scale $w.frame.scale -orient vertical -length 284 -from 0 -to 250 \ + -command "setHeight $w.frame.canvas" -tickinterval 50 + canvas $w.frame.canvas -width 50 -height 50 -bd 0 -highlightthickness 0 + $w.frame.canvas create polygon 0 0 1 1 2 2 -fill SeaGreen3 -tags poly + $w.frame.canvas create line 0 0 1 1 2 2 0 0 -fill black -tags line + frame $w.frame.right -borderwidth 15 + pack $w.frame.scale -side left -anchor ne + pack $w.frame.canvas -side left -anchor nw -fill y + $w.frame.scale set 75 + + proc setHeight {w height} { + incr height 21 + set y2 [expr $height - 30] + if {$y2 < 21} { + set y2 21 + } + $w coords poly 15 20 35 20 35 $y2 45 $y2 25 $height 5 $y2 15 $y2 15 20 + $w coords line 15 20 35 20 35 $y2 45 $y2 25 $height 5 $y2 15 $y2 15 20 + } diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/demos.jp/widget ./library/demos.jp/widget *** ../tk4.2/library/demos.jp/widget Thu Jan 1 09:00:00 1970 --- ./library/demos.jp/widget Sun Nov 24 18:25:55 1996 *************** *** 0 **** --- 1,385 ---- + #!/bin/sh + # the next line restarts using wish \ + exec wish "$0" "$@" + + # widget -- + # This script demonstrates the various widgets provided by Tk, + # along with many of the features of the Tk toolkit. This file + # only contains code to generate the main window for the + # application, which invokes individual demonstrations. The + # code for the actual demonstrations is contained in separate + # ".tcl" files is this directory, which are sourced by this script + # as needed. + # + # SCCS: @(#) widget 1.21 96/10/04 17:09:34 + + eval destroy [winfo child .] + wm title . "Widget Demonstration" + + # For the Japanese demonstrations. + set msg_kanji_font -*--24-*-jisx0208.1983-0 + set kanji_font -*--16-*-jisx0208.1983-0 + set tk_library .. + option add "*kanjiFont" $kanji_font startupFile + + #---------------------------------------------------------------- + # The code below create the main window, consisting of a menu bar + # and a text widget that explains how to use the program, plus lists + # all of the demos as hypertext items. + #---------------------------------------------------------------- + + set font -*-Helvetica-Medium-R-Normal--*-140-*-*-*-*-*-* + frame .menuBar + pack .menuBar -side top -fill x + menubutton .menuBar.file -text File -menu .menuBar.file.m -underline 0 + menu .menuBar.file.m + .menuBar.file.m add command -label "About ... " -command "aboutBox" \ + -underline 0 -accelerator "" + .menuBar.file.m add sep + .menuBar.file.m add command -label "Quit" -command "exit" -underline 0 + pack .menuBar.file -side left + bind . aboutBox + + frame .textFrame + scrollbar .s -orient vertical -command {.t yview} -highlightthickness 0 \ + -takefocus 1 + pack .s -in .textFrame -side right -fill y -padx 1 + text .t -yscrollcommand {.s set} -wrap word -width 60 -height 30 -font $font \ + -setgrid 1 -highlightthickness 0 -padx 4 -pady 2 -takefocus 0 + pack .t -in .textFrame -expand y -fill both -padx 1 + pack .textFrame -expand yes -fill both -padx 1 -pady 2 + + frame .statusBar + label .statusBar.lab -text " " -relief sunken -bd 1 \ + -font -*-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* -anchor w + label .statusBar.foo -width 8 -relief sunken -bd 1 \ + -font -*-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* -anchor w + pack .statusBar.lab -side left -padx 2 -expand yes -fill both + pack .statusBar.foo -side left -padx 2 + pack .statusBar -side top -fill x -pady 2 + + # Create a bunch of tags to use in the text widget, such as those for + # section titles and demo descriptions. Also define the bindings for + # tags. + + global msg_kanji_font + .t tag configure title -font -*-Helvetica-Bold-R-Normal--*-180-*-*-*-*-*-* + .t tag configure kanji_title -kanjifont $msg_kanji_font + + # We put some "space" characters to the left and right of each demo description + # so that the descriptions are highlighted only when the mouse cursor + # is right over them (but not when the cursor is to their left or right) + # + .t tag configure demospace -lmargin1 1c -lmargin2 1c + + + if {[winfo depth .] == 1} { + .t tag configure demo -lmargin1 1c -lmargin2 1c \ + -underline 1 + .t tag configure visited -lmargin1 1c -lmargin2 1c \ + -underline 1 + .t tag configure hot -background black -foreground white + } else { + .t tag configure demo -lmargin1 1c -lmargin2 1c \ + -foreground blue -underline 1 + .t tag configure visited -lmargin1 1c -lmargin2 1c \ + -foreground #303080 -underline 1 + .t tag configure hot -foreground red -underline 1 + } + .t tag bind demo { + invoke [.t index {@%x,%y}] + } + set lastLine "" + .t tag bind demo { + set lastLine [.t index {@%x,%y linestart}] + .t tag add hot "$lastLine +1 chars" "$lastLine lineend -1 chars" + .t config -cursor hand2 + showStatus [.t index {@%x,%y}] + } + .t tag bind demo { + .t tag remove hot 1.0 end + .t config -cursor xterm + .statusBar.lab config -text "" + } + .t tag bind demo { + set newLine [.t index {@%x,%y linestart}] + if {[string compare $newLine $lastLine] != 0} { + .t tag remove hot 1.0 end + set lastLine $newLine + + set tags [.t tag names {@%x,%y}] + set i [lsearch -glob $tags demo-*] + if {$i >= 0} { + .t tag add hot "$lastLine +1 chars" "$lastLine lineend -1 chars" + } + } + showStatus [.t index {@%x,%y}] + } + + # Create the text for the text widget. + + .t insert end "Tk Widget" title + .t insert end " デモンストレーション\n" kanji_title + .t insert end { + このアプリケーションは、Tk Widget を用いてどのようなことができるかを示すための、いくつかの小さなスクリプトに対するフロントエンドを提供しています。以下に順番に挙げられているデモンストレーションを実行するにはマウスでクリックしてください。デモンストレーションのウィンドウが現れると、デモンストレーションを生成した Tcl/Tk のコードを見るために、"コード参照" ボタンをクリックすることができます。あなたが望むなら、そのコードを修正することができます。修正したコードでデモンストレーションを再実行するためには、コードが書かれたウィンドウにある "デモ再実行" ボタンをクリックしてください。 + + } + .t insert end "ラベル, ボタン, チェックボタン, ラジオボタン" kanji_title + .t insert end " \n " {demospace} + .t insert end "1. ラベル (テキスト、ビットマップ)" {demo demo-label} + .t insert end " \n " {demospace} + .t insert end "2. ボタン" {demo demo-button} + .t insert end " \n " {demospace} + .t insert end "3. チェックボタン (複数を選択可能)" {demo demo-check} + .t insert end " \n " {demospace} + .t insert end "4. ラジオボタン (任意の一つを選択可能)" {demo demo-radio} + .t insert end " \n " {demospace} + .t insert end "5. ボタンで作られた15-パズルゲーム" {demo demo-puzzle} + .t insert end " \n " {demospace} + .t insert end "6. ビットマップを使用したアイコンボタン" {demo demo-icon} + .t insert end " \n " {demospace} + .t insert end "7. 画像を表示する二つのラベル" {demo demo-image1} + .t insert end " \n " {demospace} + .t insert end "8. 画像を見るための簡単なユーザインタフェース" \ + {demo demo-image2} + .t insert end " \n " {demospace} + + .t insert end \n {} "リストボックス" kanji_title + .t insert end " \n " {demospace} + .t insert end "1. 都道府県" {demo demo-states} + .t insert end " \n " {demospace} + .t insert end "2. 色: アプリケーションのための配色を変える" \ + {demo demo-colors} + .t insert end " \n " {demospace} + .t insert end "3. 格言集" {demo demo-sayings} + .t insert end " \n " {demospace} + + .t insert end \n {} "エントリ" kanji_title + .t insert end " \n " {demospace} + .t insert end "1. スクロールバーなし" {demo demo-entry1} + .t insert end " \n " {demospace} + .t insert end "2. スクロールバーあり" {demo demo-entry2} + .t insert end " \n " {demospace} + .t insert end "3. 簡単なフォーム" {demo demo-form} + .t insert end " \n " {demospace} + + .t insert end \n {} "テキスト" kanji_title + .t insert end " \n " {demospace} + .t insert end "1. 基本的なテキスト" {demo demo-text} + .t insert end " \n " {demospace} + .t insert end "2. 表示スタイル" {demo demo-style} + .t insert end " \n " {demospace} + .t insert end "3. ハイパーテキスト(タグバインド)" {demo demo-bind} + .t insert end " \n " {demospace} + .t insert end "4. ウィンドウを埋め込んだテキスト" {demo demo-twind} + .t insert end " \n " {demospace} + .t insert end "5. 検索機能\n" {demo demo-search} + .t insert end " \n " {demospace} + + .t insert end \n {} "キャンバス" kanji_title + .t insert end " \n " {demospace} + .t insert end "1. アイテムの型" {demo demo-items} + .t insert end " \n " {demospace} + .t insert end "2. 2次元のプロット" {demo demo-plot} + .t insert end " \n " {demospace} + .t insert end "3. テキスト" {demo demo-ctext} + .t insert end " \n " {demospace} + .t insert end "4. 矢印の形" {demo demo-arrow} + .t insert end " \n " {demospace} + .t insert end "5. ルーラー" {demo demo-ruler} + .t insert end " \n " {demospace} + .t insert end "6. フロアプラン" {demo demo-floor} + .t insert end " \n " {demospace} + .t insert end "7. スクロール可能なキャンバス" {demo demo-cscroll} + .t insert end " \n " {demospace} + + .t insert end \n {} "スケール" kanji_title + .t insert end " \n " {demospace} + .t insert end "1. 垂直" {demo demo-vscale} + .t insert end " \n " {demospace} + .t insert end "2. 水平" {demo demo-hscale} + .t insert end " \n " {demospace} + + .t insert end \n {} "メニュー" kanji_title + .t insert end " \n " {demospace} + .t insert end "1. メニューとカスケードを含んだウィンドウ" \ + {demo demo-menu} + .t insert end " \n " {demospace} + + .t insert end \n {} "ダイアログウィンドウ" kanji_title + .t insert end " \n " {demospace} + .t insert end "1. メッセージボックス" {demo demo-msgbox} + .t insert end " \n " {demospace} + .t insert end "2. ファイル選択ダイアログ" {demo demo-filebox} + .t insert end " \n " {demospace} + .t insert end "3. 色選択ダイアログ" {demo demo-clrpick} + .t insert end " \n " {demospace} + + .t insert end \n {} "その他" kanji_title + .t insert end " \n " {demospace} + .t insert end "1. 組み込みのビットマップ" {demo demo-bitmap} + .t insert end " \n " {demospace} + .t insert end "2. モーダルダイアログ(ローカルグラブ)" {demo demo-dialog1} + .t insert end " \n " {demospace} + .t insert end "3. モーダルダイアログ(グローバルグラブ)" {demo demo-dialog2} + .t insert end " \n " {demospace} + + .t configure -state disabled + focus .s + + # positionWindow -- + # This procedure is invoked by most of the demos to position a + # new demo window. + # + # Arguments: + # w - The name of the window to position. + + proc positionWindow w { + wm geometry $w +300+300 + } + + # showVars -- + # Displays the values of one or more variables in a window, and + # updates the display whenever any of the variables changes. + # + # Arguments: + # w - Name of new window to create for display. + # args - Any number of names of variables. + + proc showVars {w args} { + catch {destroy $w} + toplevel $w + wm title $w "Variable values" + label $w.title -text 変数値： -width 20 -anchor center \ + -font -Adobe-helvetica-medium-r-normal--*-180-*-*-*-*-*-* + pack $w.title -side top -fill x + set len 1 + foreach i $args { + if {[string length $i] > $len} { + set len [string length $i] + } + } + foreach i $args { + frame $w.$i + label $w.$i.name -text "$i: " -width [expr $len + 2] -anchor w + label $w.$i.value -textvar $i -anchor w + pack $w.$i.name -side left + pack $w.$i.value -side left -expand 1 -fill x + pack $w.$i -side top -anchor w -fill x + } + button $w.ok -text 了解 -command "destroy $w" + pack $w.ok -side bottom -pady 2 + } + + # invoke -- + # This procedure is called when the user clicks on a demo description. + # It is responsible for invoking the demonstration. + # + # Arguments: + # index - The index of the character that the user clicked on. + + proc invoke index { + global tk_library + set tags [.t tag names $index] + set i [lsearch -glob $tags demo-*] + if {$i < 0} { + return + } + set cursor [.t cget -cursor] + .t configure -cursor watch + update + set demo [string range [lindex $tags $i] 5 end] + uplevel [list source [file join $tk_library demos.jp $demo.tcl]] + update + .t configure -cursor $cursor + + .t tag add visited "$index linestart +1 chars" "$index lineend -1 chars" + } + + # showStatus -- + # + # Show the name of the demo program in the status bar. This procedure + # is called when the user moves the cursor over a demo description. + # + proc showStatus index { + global tk_library + set tags [.t tag names $index] + set i [lsearch -glob $tags demo-*] + set cursor [.t cget -cursor] + if {$i < 0} { + .statusBar.lab config -text " " + set newcursor xterm + } else { + set demo [string range [lindex $tags $i] 5 end] + .statusBar.lab config -text "サンプルプログラム \"$demo\" の実行" + set newcursor hand2 + } + if [string compare $cursor $newcursor] { + .t config -cursor $newcursor + } + } + + + # showCode -- + # This procedure creates a toplevel window that displays the code for + # a demonstration and allows it to be edited and reinvoked. + # + # Arguments: + # w - The name of the demonstration's window, which can be + # used to derive the name of the file containing its code. + + proc showCode w { + global tk_library + set file [string range $w 1 end].tcl + if ![winfo exists .code] { + toplevel .code + frame .code.buttons + pack .code.buttons -side bottom -fill x + button .code.buttons.dismiss -text 了解 -command "destroy .code" + button .code.buttons.rerun -text 再実行 -command { + eval [.code.text get 1.0 end] + } + pack .code.buttons.dismiss .code.buttons.rerun -side left \ + -expand 1 -pady 2 + frame .code.frame + pack .code.frame -expand yes -fill both -padx 1 -pady 1 + text .code.text -height 40 -wrap word\ + -xscrollcommand ".code.xscroll set" \ + -yscrollcommand ".code.yscroll set" \ + -setgrid 1 -highlightthickness 0 -pady 2 -padx 3 + scrollbar .code.xscroll -command ".code.text xview" \ + -highlightthickness 0 -orient horizontal + scrollbar .code.yscroll -command ".code.text yview" \ + -highlightthickness 0 -orient vertical + + grid .code.text -in .code.frame -padx 1 -pady 1 \ + -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news + grid .code.yscroll -in .code.frame -padx 1 -pady 1 \ + -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news + # grid .code.xscroll -in .code.frame -padx 1 -pady 1 \ + # -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news + grid rowconfig .code.frame 0 -weight 1 -minsize 0 + grid columnconfig .code.frame 0 -weight 1 -minsize 0 + } else { + wm deiconify .code + raise .code + } + wm title .code "Demo code: [file join $tk_library demos.jp $file]" + wm iconname .code $file + set id [open [file join $tk_library demos.jp $file]] + .code.text delete 1.0 end + .code.text insert 1.0 [read $id] + .code.text mark set insert 1.0 + close $id + } + + # aboutBox -- + # + # Pops up a message box with an "about" message + # + proc aboutBox {} { + tk_messageBox -icon info -type ok -title "About Widget Demo" -message \ + "Tk ウィジェットデモ\n\n\ + Copyright (c) 1996 Sun Microsystems, Inc." + } + diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/kinput.tcl ./library/kinput.tcl *** ../tk4.2/library/kinput.tcl Thu Jan 1 09:00:00 1970 --- ./library/kinput.tcl Fri Oct 18 13:15:15 1996 *************** *** 0 **** --- 1,121 ---- + # kinput.tcl -- + # + # This file contains Tcl procedures used to input Japanese text. + # + # $Header: /ext/cvsroot/tk/library/kinput.tcl,v 1.1 1995/12/21 08:31:57 hoshi Exp $ + # + # 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. + # + + # ---------------------------------------------------------------------- + # Class bindings for start Japanese text input (Kana-Kanji conversion). + # Use over-the-spot style for text widgets, root style for entry widgets. + # ---------------------------------------------------------------------- + + #bind Text {kinput_start %W over} + bind Text {kinput_start %W over} + bind Text {kinput_start %W over} + bind Text {kinput_start %W over} + + #bind Entry {kinput_start %W} + bind Entry {kinput_start %W} + bind Entry {kinput_start %W} + bind Entry {kinput_start %W} + + + # The procedure below is invoked in order to start Japanese text input + # for the specified widget. It sends a request to the input server to + # start conversion on that widget. + # Second argument specifies input style. Valid values are "over" (for + # over-the-spot style) and "root" (for root window style). See X11R5 + # Xlib manual for the meaning of these styles). The default is root + # window style. + + proc kinput_start {w {style root}} { + global _kinput_priv + catch {unset _kinput_priv($w)} + if {$style=="over"} then { + set spot [_kinput_spot $w] + if {"$spot" != ""} then { + trace variable _kinput_priv($w) w _kinput_trace_$style + kanjiInput start $w \ + -variable _kinput_priv($w) \ + -inputStyle over \ + -foreground [_kinput_attr $w -foreground] \ + -background [_kinput_attr $w -background] \ + -fonts [list [_kinput_attr $w -font] \ + [_kinput_attr $w -kanjifont]] \ + -clientArea [_kinput_area $w] \ + -spot $spot + return + } + } + trace variable _kinput_priv($w) w _kinput_trace_root + kanjiInput start $w -variable _kinput_priv($w) -inputStyle root + } + + # The procedure below is invoked to send the spot location (the XY + # coordinate of the point where characters to be inserted) to the + # input server. It should be called whenever the location has + # been changed while in over-the-spot conversion mode. + + proc kinput_send_spot {w} { + set spot [_kinput_spot $w] + if {"$spot" != ""} then { + kanjiInput attribute $w -spot $spot + } + } + + # + # All of the procedures below are the internal procedures for this + # package. + # + + # The following procedure returns the list of XY coordinate of the + # current insertion point of the specified widget. + + proc _kinput_spot {w} { + $w xypos insert + } + + # The following procedure returns the list of drawing area of the + # specified widget. { x y width height } + + proc _kinput_area {w} { + set bw [_kinput_attr $w -borderwidth] + return "$bw $bw [expr {[winfo width $w] - $bw*2}] [expr {[winfo height $w] - $bw*2}]" + } + + # The following procedure returns the value of the specified option + # (resource). + proc _kinput_attr {w option} {lindex [$w configure $option] 4} + + # The two procedures below are callbacks of a variable tracing. + # The traced variable contains the text string sent from the + # input server as a conversion result. + + # for root style + proc _kinput_trace_root {name1 name2 op} { + upvar #0 $name1 trvar + $name2 insert insert $trvar($name2) + unset $trvar($name2) + } + + # for over-the-spot style + proc _kinput_trace_over {name1 name2 op} { + upvar #0 $name1 trvar + $name2 insert insert $trvar($name2) + kinput_send_spot $name2 + unset $trvar($name2) + } diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/msgbox.tcl ./library/msgbox.tcl *** ../tk4.2/library/msgbox.tcl Tue Sep 10 01:54:59 1996 --- ./library/msgbox.tcl Sun Nov 24 17:01:51 1996 *************** *** 148,153 **** --- 148,154 ---- catch {$w.msg configure -font \ -Adobe-Times-Medium-R-Normal--*-180-*-*-*-*-*-* } + catch {$w.msg configure -kanjifont -*--24-*-jisx0208.1983-0} pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m if {$data(-icon) != ""} { label $w.bitmap -bitmap $data(-icon) diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/prolog.ps ./library/prolog.ps *** ../tk4.2/library/prolog.ps Tue Aug 27 02:08:29 1996 --- ./library/prolog.ps Fri Oct 18 13:15:15 1996 *************** *** 20,25 **** --- 20,26 ---- /strings 0 def /xoffset 0 def /yoffset 0 def + /partwidth 0 def /tmpstip null def % Define the array ISOLatin1Encoding (which specifies how characters are *************** *** 80,86 **** /ISOEncode { dup length dict begin {1 index /FID ne {def} {pop pop} ifelse} forall ! /Encoding ISOLatin1Encoding def currentdict end --- 81,89 ---- /ISOEncode { dup length dict begin {1 index /FID ne {def} {pop pop} ifelse} forall ! Encoding StandardEncoding eq { ! /Encoding ISOLatin1Encoding def ! } if currentdict end *************** *** 228,235 **** newpath } forall ! % Compute the baseline offset and the actual font height. 0 0 moveto (TXygqPZ) false charpath pathbbox dup /baseline exch def exch pop exch sub /height exch def pop --- 231,239 ---- newpath } forall ! % Compute the baseline offset and the actual font height using ascii font. + asciifont setfont 0 0 moveto (TXygqPZ) false charpath pathbbox dup /baseline exch def exch pop exch sub /height exch def pop *************** *** 279,284 **** --- 283,405 ---- } {show} ifelse 0 spacing neg translate } forall + } bind def + + % width string TotalWidth newwidth + % Given a font already set up, this procedure will calculate + % the width of specified string, add it to width on stack. + + /TotalWidth { + /partwidth 0 def + 0 0 moveto + { % charCode x y + pop exch pop % now x on top of the stack + partwidth add /partwidth exch def + } exch cshow + partwidth add + } bind def + + % string kanjishow -- -or- width string kanjishow newwidth + % string asciishow -- -or- width string asciishow newwidth + % + % These procedures set appropriate font and either draw the specified + % string or calculate the width of it depending on the binding of + % MFTextHook procedure. + + /kanjishow { kanjifont setfont MFTextHook } bind def + /asciishow { asciifont setfont MFTextHook } bind def + + % x y strings spacing xoffset yoffset justify stipple stipimage MFDrawText -- + % This procedure is similar to DrawText, except it supports multiple + % fonts. All but strings arguments are same as DrawText's. + % + % strings - An array of line-arrays, one for each line of the text item, + % in order from top to bottom. Each line-array is in turn + % an array, whose elements are pairs of string and + % corresponding show procedure -- ie asciishow or kanjishow. + + /MFDrawText { + /stipple exch def + /justify exch def + /yoffset exch def + /xoffset exch def + /spacing exch def + /strings exch def + + % First scan through all of the text to find the widest line. + + /lineLength 0 def + /MFTextHook { TotalWidth } def + + strings { + 0 exch cvx { exec } forall + dup lineLength gt {/lineLength exch def} {pop} ifelse + } forall + + % Compute the baseline offset and the actual font height using ascii font. + + asciifont setfont + 0 0 moveto (TXygqPZ) false charpath + pathbbox dup /baseline exch def + exch pop exch sub /height exch def pop + newpath + + % Translate coordinates first so that the origin is at the upper-left + % corner of the text's bounding box. Remember that x and y for + % positioning are still on the stack. + + translate + lineLength xoffset mul + strings length 1 sub spacing mul height add yoffset mul translate + + % Now use the baseline and justification information to translate so + % that the origin is at the baseline and positioning point for the + % first line of text. + + justify lineLength mul baseline neg translate + + % Iterate over each of the lines to output it. For each line, + % compute its width again so it can be properly justified, then + % display it. + + strings { + dup + % get width of a line + /MFTextHook { TotalWidth } def + 0 exch cvx { exec } forall + % justify it + justify mul neg 0 moveto + stipple { + % set character path and do StippleText + /MFTextHook { MFStipple } def + } { + % show it + /MFTextHook { show } def + } ifelse + gsave + cvx { exec } forall + grestore + 0 spacing neg translate + } forall + } bind def + + % This is a hook procedure of MFDrawText. + % Get path of each character of a string and clip by them. + % Then do StippleText proc. + + /MFStipple { % (string) MFStipple - + /aStr 1 string def + { % charCode x y + 3 -1 roll % re-order as x y charCode + aStr exch 0 exch put % put a charCode into aStr + currentpoint % x y curX curY + gsave + aStr true charpath clip StippleText + grestore + 4 2 roll % curX curY x y + translate % curX curY + moveto % - + } exch cshow } bind def %%EndProlog diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/library/tk.tcl ./library/tk.tcl *** ../tk4.2/library/tk.tcl Thu Oct 3 06:55:56 1996 --- ./library/tk.tcl Fri Oct 18 13:15:15 1996 *************** *** 153,155 **** --- 153,161 ---- after cancel $tkPriv(afterId) set tkPriv(afterId) {} } + + + # For Japanese text input + if {[info commands kanjiInput] != ""} then { + source $tk_library/kinput.tcl + } diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/tests/button.test ./tests/button.test *** ../tk4.2/tests/button.test Tue Aug 27 05:26:57 1996 --- ./tests/button.test Fri Oct 18 13:15:16 1996 *************** *** 227,233 **** } {1 {unknown option "-onvalue"}} test button-4.14 {ButtonWidgetCmd procedure, "configure" option} { llength [.c configure] ! } {36} test button-4.15 {ButtonWidgetCmd procedure, "configure" option} { list [catch {.b configure -gorp} msg] $msg } {1 {unknown option "-gorp"}} --- 227,233 ---- } {1 {unknown option "-onvalue"}} test button-4.14 {ButtonWidgetCmd procedure, "configure" option} { llength [.c configure] ! } [jp&orig {37} {36}] test button-4.15 {ButtonWidgetCmd procedure, "configure" option} { list [catch {.b configure -gorp} msg] $msg } {1 {unknown option "-gorp"}} diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/tests/clipboard.test ./tests/clipboard.test *** ../tk4.2/tests/clipboard.test Tue Aug 27 02:08:04 1996 --- ./tests/clipboard.test Fri Oct 18 13:15:16 1996 *************** *** 116,122 **** clipboard append "Test" selection clear -s CLIPBOARD list [catch {selection get -s CLIPBOARD} msg] $msg ! } {1 {CLIPBOARD selection doesn't exist or form "STRING" not defined}} test clipboard-4.2 {ClipboardLostSel procedure} { clipboard clear clipboard append "Test" --- 116,124 ---- clipboard append "Test" selection clear -s CLIPBOARD list [catch {selection get -s CLIPBOARD} msg] $msg ! } [jp&orig \ ! {1 {CLIPBOARD selection doesn't exist or form "COMPOUND_TEXT" not defined}} \ ! {1 {CLIPBOARD selection doesn't exist or form "STRING" not defined}}] test clipboard-4.2 {ClipboardLostSel procedure} { clipboard clear clipboard append "Test" *************** *** 124,130 **** selection clear -s CLIPBOARD list [catch {selection get -s CLIPBOARD} msg] $msg \ [catch {selection get -s CLIPBOARD -t TEST} msg] $msg ! } {1 {CLIPBOARD selection doesn't exist or form "STRING" not defined} 1 {CLIPBOARD selection doesn't exist or form "TEST" not defined}} test clipboard-4.3 {ClipboardLostSel procedure} { clipboard clear clipboard append "Test" --- 126,134 ---- selection clear -s CLIPBOARD list [catch {selection get -s CLIPBOARD} msg] $msg \ [catch {selection get -s CLIPBOARD -t TEST} msg] $msg ! } [jp&orig \ ! {1 {CLIPBOARD selection doesn't exist or form "COMPOUND_TEXT" not defined} 1 {CLIPBOARD selection doesn't exist or form "TEST" not defined}} \ ! {1 {CLIPBOARD selection doesn't exist or form "STRING" not defined} 1 {CLIPBOARD selection doesn't exist or form "TEST" not defined}}] test clipboard-4.3 {ClipboardLostSel procedure} { clipboard clear clipboard append "Test" *************** *** 133,139 **** selection clear -s CLIPBOARD list [catch {selection get -s CLIPBOARD} msg] $msg \ [catch {selection get -s CLIPBOARD -t TEST} msg] $msg ! } {1 {CLIPBOARD selection doesn't exist or form "STRING" not defined} 1 {CLIPBOARD selection doesn't exist or form "TEST" not defined}} ############################################################################## --- 137,145 ---- selection clear -s CLIPBOARD list [catch {selection get -s CLIPBOARD} msg] $msg \ [catch {selection get -s CLIPBOARD -t TEST} msg] $msg ! } [jp&orig \ ! {1 {CLIPBOARD selection doesn't exist or form "COMPOUND_TEXT" not defined} 1 {CLIPBOARD selection doesn't exist or form "TEST" not defined}} \ ! {1 {CLIPBOARD selection doesn't exist or form "STRING" not defined} 1 {CLIPBOARD selection doesn't exist or form "TEST" not defined}}] ############################################################################## *************** *** 178,184 **** clipboard clear clipboard append -f INTEGER -t TEST "16" list [catch {clipboard append -t TEST "test"} msg] $msg ! } {1 {format "STRING" does not match current format "INTEGER" for TEST}} ############################################################################## --- 184,192 ---- clipboard clear clipboard append -f INTEGER -t TEST "16" list [catch {clipboard append -t TEST "test"} msg] $msg ! } [jp&orig \ ! {1 {format "COMPOUND_TEXT" does not match current format "INTEGER" for TEST}} \ ! {1 {format "STRING" does not match current format "INTEGER" for TEST}}] ############################################################################## diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/tests/defs ./tests/defs *** ../tk4.2/tests/defs Tue Sep 10 01:54:50 1996 --- ./tests/defs Fri Oct 18 13:15:17 1996 *************** *** 294,296 **** --- 294,320 ---- catch {exec rm -f $name} } } + + + # Japanized version of Tk 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 + } + } + + option add *Label.font "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*" + option add *Button.font "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*" + option add *Checkbutton.font "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*" + option add *Radiobutton.font "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*" + option add *Entry.font "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*" + option add *Listbox.font "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*" + option add *Menu.font "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*" + option add *Menubutton.font "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*" + option add *Message.font "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*" + option add *Scale.font "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*" + option add *Text.font "-*-Courier-Medium-R-Normal--*-120-*-*-*-*-*-*" diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/tests/entry.test ./tests/entry.test *** ../tk4.2/tests/entry.test Wed Aug 28 02:36:37 1996 --- ./tests/entry.test Fri Oct 18 13:15:17 1996 *************** *** 154,160 **** } {4} test entry-3.11 {EntryWidgetCmd procedure, "configure" widget command} { llength [.e configure] ! } {28} test entry-3.12 {EntryWidgetCmd procedure, "configure" widget command} { list [catch {.e configure -foo} msg] $msg } {1 {unknown option "-foo"}} --- 154,160 ---- } {4} test entry-3.11 {EntryWidgetCmd procedure, "configure" widget command} { llength [.e configure] ! } [jp&orig {29} {28}] test entry-3.12 {EntryWidgetCmd procedure, "configure" widget command} { list [catch {.e configure -foo} msg] $msg } {1 {unknown option "-foo"}} *************** *** 218,224 **** } {4} test entry-3.26 {EntryWidgetCmd procedure, "index" widget command} { list [catch {.e in} msg] $msg ! } {1 {bad option "in": must be bbox, cget, configure, delete, get, icursor, index, insert, scan, selection, or xview}} test entry-3.27 {EntryWidgetCmd procedure, "index" widget command} { list [catch {.e index} msg] $msg } {1 {wrong # args: should be ".e index string"}} --- 218,226 ---- } {4} test entry-3.26 {EntryWidgetCmd procedure, "index" widget command} { list [catch {.e in} msg] $msg ! } [jp&orig \ ! {1 {bad option "in": must be bbox, cget, configure, delete, get, icursor, index, insert, scan, selection, xview, or xypos}} \ ! {1 {bad option "in": must be bbox, cget, configure, delete, get, icursor, index, insert, scan, selection, or xview}}] test entry-3.27 {EntryWidgetCmd procedure, "index" widget command} { list [catch {.e index} msg] $msg } {1 {wrong # args: should be ".e index string"}} *************** *** 294,300 **** update .e select clear list [catch {selection get} msg] $msg [selection own] ! } {1 {PRIMARY selection doesn't exist or form "STRING" not defined} .e} test entry-3.45 {EntryWidgetCmd procedure, "selection present" widget command} { list [catch {.e selection present foo} msg] $msg } {1 {wrong # args: should be ".e selection present"}} --- 296,304 ---- update .e select clear list [catch {selection get} msg] $msg [selection own] ! } [jp&orig \ ! {1 {PRIMARY selection doesn't exist or form "COMPOUND_TEXT" not defined} .e} \ ! {1 {PRIMARY selection doesn't exist or form "STRING" not defined} .e}] test entry-3.45 {EntryWidgetCmd procedure, "selection present" widget command} { list [catch {.e selection present foo} msg] $msg } {1 {wrong # args: should be ".e selection present"}} *************** *** 447,453 **** } {73} test entry-3.75 {EntryWidgetCmd procedure} { list [catch {.e gorp} msg] $msg ! } {1 {bad option "gorp": must be bbox, cget, configure, delete, get, icursor, index, insert, scan, selection, or xview}} # The test below doesn't actually check anything directly, but if run # with Purify or some other memory-allocation-checking program it will --- 451,459 ---- } {73} test entry-3.75 {EntryWidgetCmd procedure} { list [catch {.e gorp} msg] $msg ! } [jp&orig \ ! {1 {bad option "gorp": must be bbox, cget, configure, delete, get, icursor, index, insert, scan, selection, xview, or xypos}} \ ! {1 {bad option "gorp": must be bbox, cget, configure, delete, get, icursor, index, insert, scan, selection, or xview}}] # The test below doesn't actually check anything directly, but if run # with Purify or some other memory-allocation-checking program it will *************** *** 528,534 **** .e configure -exportselection 0 list [catch {selection get} msg] $msg [.e index sel.first] \ [.e index sel.last] ! } {1 {PRIMARY selection doesn't exist or form "STRING" not defined} 1 5} test entry-5.7 {ConfigureEntry procedure} { catch {destroy .e} entry .e -font $fixed -width 4 -xscrollcommand scroll --- 534,542 ---- .e configure -exportselection 0 list [catch {selection get} msg] $msg [.e index sel.first] \ [.e index sel.last] ! } [jp&orig \ ! {1 {PRIMARY selection doesn't exist or form "COMPOUND_TEXT" not defined} 1 5} \ ! {1 {PRIMARY selection doesn't exist or form "STRING" not defined} 1 5}] test entry-5.7 {ConfigureEntry procedure} { catch {destroy .e} entry .e -font $fixed -width 4 -xscrollcommand scroll diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/tests/listbox.test ./tests/listbox.test *** ../tk4.2/tests/listbox.test Tue Aug 27 05:27:01 1996 --- ./tests/listbox.test Fri Oct 18 13:15:17 1996 *************** *** 211,217 **** } {0} test listbox-3.18 {ListboxWidgetCmd procedure, "configure" option} { llength [.l configure] ! } {23} test listbox-3.19 {ListboxWidgetCmd procedure, "configure" option} { list [catch {.l configure -gorp} msg] $msg } {1 {unknown option "-gorp"}} --- 211,217 ---- } {0} test listbox-3.18 {ListboxWidgetCmd procedure, "configure" option} { llength [.l configure] ! } [jp&orig {24} {23}] test listbox-3.19 {ListboxWidgetCmd procedure, "configure" option} { list [catch {.l configure -gorp} msg] $msg } {1 {unknown option "-gorp"}} *************** *** 644,652 **** lappend x [catch {selection get} msg] $msg [.l curselection] .l config -exportselection 1 lappend x [catch {selection get} msg] $msg [.l curselection] ! } {0 el1 1 1 {PRIMARY selection doesn't exist or form "STRING" not defined} 1 1 {PRIMARY selection doesn't exist or form "STRING" not defined} {} 1 {PRIMARY selection doesn't exist or form "STRING" not defined} {1 2 3} 0 {el1 el2 ! el3} {1 2 3}} test listbox-4.6 {ConfigureListbox procedure} {fonts} { catch {destroy .l} --- 644,656 ---- lappend x [catch {selection get} msg] $msg [.l curselection] .l config -exportselection 1 lappend x [catch {selection get} msg] $msg [.l curselection] ! } [jp&orig \ ! {0 el1 1 1 {PRIMARY selection doesn't exist or form "COMPOUND_TEXT" not defined} 1 1 {PRIMARY selection doesn't exist or form "COMPOUND_TEXT" not defined} {} 1 {PRIMARY selection doesn't exist or form "COMPOUND_TEXT" not defined} {1 2 3} 0 {el1 el2 ! el3} {1 2 3}} \ ! {0 el1 1 1 {PRIMARY selection doesn't exist or form "STRING" not defined} 1 1 {PRIMARY selection doesn't exist or form "STRING" not defined} {} 1 {PRIMARY selection doesn't exist or form "STRING" not defined} {1 2 3} 0 {el1 ! el2 ! el3} {1 2 3}}] test listbox-4.6 {ConfigureListbox procedure} {fonts} { catch {destroy .l} diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/tests/menubut.test ./tests/menubut.test *** ../tk4.2/tests/menubut.test Tue Aug 27 05:27:05 1996 --- ./tests/menubut.test Fri Oct 18 13:15:18 1996 *************** *** 129,135 **** } {3} test menubutton-3.7 {ButtonWidgetCmd procedure, "configure" option} { llength [.mb configure] ! } {31} test menubutton-3.8 {ButtonWidgetCmd procedure, "configure" option} { list [catch {.mb configure -gorp} msg] $msg } {1 {unknown option "-gorp"}} --- 129,135 ---- } {3} test menubutton-3.7 {ButtonWidgetCmd procedure, "configure" option} { llength [.mb configure] ! } [jp&orig {32} {31}] test menubutton-3.8 {ButtonWidgetCmd procedure, "configure" option} { list [catch {.mb configure -gorp} msg] $msg } {1 {unknown option "-gorp"}} diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/tests/scale.test ./tests/scale.test *** ../tk4.2/tests/scale.test Tue Aug 27 05:27:02 1996 --- ./tests/scale.test Fri Oct 18 13:15:18 1996 *************** *** 118,124 **** } {2} test scale-3.6 {ScaleWidgetCmd procedure, configure option} { list [llength [.s configure]] [lindex [.s configure] 5] ! } {33 {-borderwidth borderWidth BorderWidth 2 2}} test scale-3.7 {ScaleWidgetCmd procedure, configure option} { list [catch {.s configure -foo} msg] $msg } {1 {unknown option "-foo"}} --- 118,126 ---- } {2} test scale-3.6 {ScaleWidgetCmd procedure, configure option} { list [llength [.s configure]] [lindex [.s configure] 5] ! } [jp&orig \ ! {34 {-borderwidth borderWidth BorderWidth 2 2}} \ ! {33 {-borderwidth borderWidth BorderWidth 2 2}}] test scale-3.7 {ScaleWidgetCmd procedure, configure option} { list [catch {.s configure -foo} msg] $msg } {1 {unknown option "-foo"}} diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/tests/select.test ./tests/select.test *** ../tk4.2/tests/select.test Tue Aug 27 02:07:58 1996 --- ./tests/select.test Fri Oct 18 13:15:19 1996 *************** *** 135,141 **** selection handle .f1 {handler TEST} TEST selection handle .f1 {handler STRING} lsort [selection get TARGETS] ! } {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW} test select-1.5 {Tk_CreateSelHandler procedure} { global selValue selInfo setup --- 135,143 ---- selection handle .f1 {handler TEST} TEST selection handle .f1 {handler STRING} lsort [selection get TARGETS] ! } [jp&orig \ ! {COMPOUND_TEXT MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW} \ ! {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}] test select-1.5 {Tk_CreateSelHandler procedure} { global selValue selInfo setup *************** *** 157,163 **** selection handle .f1 {handler TEST2} TEST selection get -type TEST list [set selInfo] [lsort [selection get TARGETS]] ! } {{STRING 0 4000 TEST 0 4000 TEST2 0 4000} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}} test select-1.7 {Tk_CreateSelHandler procedure} { setup selection own -selection CLIPBOARD .f1 --- 159,167 ---- selection handle .f1 {handler TEST2} TEST selection get -type TEST list [set selInfo] [lsort [selection get TARGETS]] ! } [jp&orig \ ! {{STRING 0 4000 TEST 0 4000 TEST2 0 4000} {COMPOUND_TEXT MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}} \ ! {{STRING 0 4000 TEST 0 4000 TEST2 0 4000} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}}] test select-1.7 {Tk_CreateSelHandler procedure} { setup selection own -selection CLIPBOARD .f1 *************** *** 182,188 **** set result [list [lsort [selection get TARGETS]]] selection handle -type TEST .f1 {} lappend result [lsort [selection get TARGETS]] ! } {{MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW USER} {MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW USER}} test select-2.2 {Tk_DeleteSelHandler procedure} { setup selection handle .f1 {handler STRING} --- 186,194 ---- set result [list [lsort [selection get TARGETS]]] selection handle -type TEST .f1 {} lappend result [lsort [selection get TARGETS]] ! } [jp&orig \ ! {{COMPOUND_TEXT MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW USER} {COMPOUND_TEXT MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW USER}} \ ! {{MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW USER} {MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW USER}}] test select-2.2 {Tk_DeleteSelHandler procedure} { setup selection handle .f1 {handler STRING} *************** *** 191,197 **** set result [list [lsort [selection get TARGETS]]] selection handle -type USER .f1 {} lappend result [lsort [selection get TARGETS]] ! } {{MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW USER} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}} test select-2.3 {Tk_DeleteSelHandler procedure} { setup selection own -selection CLIPBOARD .f1 --- 197,205 ---- set result [list [lsort [selection get TARGETS]]] selection handle -type USER .f1 {} lappend result [lsort [selection get TARGETS]] ! } [jp&orig \ ! {{COMPOUND_TEXT MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW USER} {COMPOUND_TEXT MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}} \ ! {{MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW USER} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}}] test select-2.3 {Tk_DeleteSelHandler procedure} { setup selection own -selection CLIPBOARD .f1 *************** *** 200,206 **** selection handle -selection CLIPBOARD .f1 {} list [lsort [selection get TARGETS]] \ [lsort [selection get -selection CLIPBOARD TARGETS]] ! } {{MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}} test select-2.4 {Tk_DeleteSelHandler procedure} { setup selection handle .f1 {handler STRING} --- 208,216 ---- selection handle -selection CLIPBOARD .f1 {} list [lsort [selection get TARGETS]] \ [lsort [selection get -selection CLIPBOARD TARGETS]] ! } [jp&orig \ ! {{COMPOUND_TEXT MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}} \ ! {{MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}}] test select-2.4 {Tk_DeleteSelHandler procedure} { setup selection handle .f1 {handler STRING} *************** *** 405,411 **** set selInfo "" selection handle .f1 {weirdHandler STRING} list [catch {selection get} msg] $msg ! } {1 {PRIMARY selection doesn't exist or form "STRING" not defined}} test select-5.7 {Tk_GetSelection procedure} { proc weirdHandler {type offset count} { destroy .f1 --- 415,423 ---- set selInfo "" selection handle .f1 {weirdHandler STRING} list [catch {selection get} msg] $msg ! } [jp&orig \ ! {1 {PRIMARY selection doesn't exist or form "COMPOUND_TEXT" not defined}} \ ! {1 {PRIMARY selection doesn't exist or form "STRING" not defined}}] test select-5.7 {Tk_GetSelection procedure} { proc weirdHandler {type offset count} { destroy .f1 *************** *** 416,422 **** set selInfo "" selection handle .f1 {weirdHandler STRING} list [catch {selection get} msg] $msg ! } {1 {PRIMARY selection doesn't exist or form "STRING" not defined}} test select-5.8 {Tk_GetSelection procedure} { proc weirdHandler {type offset count} { selection clear --- 428,436 ---- set selInfo "" selection handle .f1 {weirdHandler STRING} list [catch {selection get} msg] $msg ! } [jp&orig \ ! {1 {PRIMARY selection doesn't exist or form "COMPOUND_TEXT" not defined}} \ ! {1 {PRIMARY selection doesn't exist or form "STRING" not defined}}] test select-5.8 {Tk_GetSelection procedure} { proc weirdHandler {type offset count} { selection clear *************** *** 427,433 **** set selInfo "" selection handle .f1 {weirdHandler STRING} list [selection get] $selInfo [catch {selection get} msg] $msg ! } "$longValue {STRING 0 4000 STRING 4000 4000 STRING 8000 4000 STRING 12000 4000 STRING 16000 4000} 1 {PRIMARY selection doesn't exist or form \"STRING\" not defined}" test select-5.9 {Tk_GetSelection procedure} { setup setupbg --- 441,449 ---- set selInfo "" selection handle .f1 {weirdHandler STRING} list [selection get] $selInfo [catch {selection get} msg] $msg ! } [jp&orig \ ! "$longValue {STRING 0 4000 STRING 4000 4000 STRING 8000 4000 STRING 12000 4000 STRING 16000 4000} 1 {PRIMARY selection doesn't exist or form \"COMPOUND_TEXT\" not defined}" \ ! "$longValue {STRING 0 4000 STRING 4000 4000 STRING 8000 4000 STRING 12000 4000 STRING 16000 4000} 1 {PRIMARY selection doesn't exist or form \"STRING\" not defined}"] test select-5.9 {Tk_GetSelection procedure} { setup setupbg *************** *** 822,828 **** tkwait variable bgDone cleanupbg list $bgData $selInfo ! } {{1 PRIMARY selection doesn't exist or form "STRING" not defined} {}} test select-10.2 {ConvertSelection procedure} { setup setupbg --- 838,846 ---- tkwait variable bgDone cleanupbg list $bgData $selInfo ! } [jp&orig \ ! {{1 PRIMARY selection doesn't exist or form "COMPOUND_TEXT" not defined} {}} \ ! {{1 PRIMARY selection doesn't exist or form "STRING" not defined} {}}] test select-10.2 {ConvertSelection procedure} { setup setupbg *************** *** 862,873 **** set selValue "Test value" set selInfo "" selection handle -type TEST .f1 { handler TEST } ! selection handle -type STRING .f1 { badHandler .f1 STRING } set result "" lappend result [dobg {selection get}] cleanupbg lappend result $selInfo ! } {{PRIMARY selection doesn't exist or form "STRING" not defined} {.f1 STRING 0 4000}} test select-10.6 {ConvertSelection procedure, reentrancy issues} { proc weirdHandler {type offset count} { destroy .f1 --- 880,897 ---- set selValue "Test value" set selInfo "" selection handle -type TEST .f1 { handler TEST } ! if {[info commands kanji] == "kanji"} { ! selection handle -type COMPOUND_TEXT .f1 { badHandler .f1 COMPOUND_TEXT } ! } else { ! selection handle -type STRING .f1 { badHandler .f1 STRING } ! } set result "" lappend result [dobg {selection get}] cleanupbg lappend result $selInfo ! } [jp&orig \ ! {{PRIMARY selection doesn't exist or form "COMPOUND_TEXT" not defined} {.f1 COMPOUND_TEXT 0 4000}} \ ! {{PRIMARY selection doesn't exist or form "STRING" not defined} {.f1 STRING 0 4000}}] test select-10.6 {ConvertSelection procedure, reentrancy issues} { proc weirdHandler {type offset count} { destroy .f1 *************** *** 877,888 **** setupbg set selValue $longValue set selInfo "" ! selection handle .f1 {weirdHandler STRING} set result "" lappend result [dobg {selection get}] cleanupbg lappend result $selInfo ! } {{PRIMARY selection doesn't exist or form "STRING" not defined} {STRING 0 4000}} ############################################################################## --- 901,918 ---- setupbg set selValue $longValue set selInfo "" ! if {[info commands kanji] == "kanji"} { ! selection handle .f1 {weirdHandler COMPOUND_TEXT} ! } else { ! selection handle .f1 {weirdHandler STRING} ! } set result "" lappend result [dobg {selection get}] cleanupbg lappend result $selInfo ! } [jp&orig \ ! {{PRIMARY selection doesn't exist or form "COMPOUND_TEXT" not defined} {COMPOUND_TEXT 0 4000}} \ ! {{PRIMARY selection doesn't exist or form "STRING" not defined} {STRING 0 4000}}] ############################################################################## *************** *** 893,905 **** set selValue $longValue set selInfo "" selection handle -type TEST .f1 { handler TEST } ! selection handle -type STRING .f1 { reallyBadHandler .f1 STRING } set result "" set pass 0 lappend result [dobg {selection get}] cleanupbg lappend result $selInfo ! } {{selection owner didn't respond} {.f1 STRING 0 4000 .f1 STRING 4000 4000 .f1 STRING 8000 4000 .f1 STRING 12000 4000 .f1 STRING 16000 4000 .f1 STRING 0 4000 .f1 STRING 4000 4000}} ############################################################################## --- 923,941 ---- set selValue $longValue set selInfo "" selection handle -type TEST .f1 { handler TEST } ! if {[info commands kanji] == "kanji"} { ! selection handle -type COMPOUND_TEXT .f1 { reallyBadHandler .f1 COMPOUND_TEXT } ! } else { ! selection handle -type STRING .f1 { reallyBadHandler .f1 STRING } ! } set result "" set pass 0 lappend result [dobg {selection get}] cleanupbg lappend result $selInfo ! } [jp&orig \ ! {{selection owner didn't respond} {.f1 COMPOUND_TEXT 0 4000 .f1 COMPOUND_TEXT 4000 4000 .f1 COMPOUND_TEXT 8000 4000 .f1 COMPOUND_TEXT 12000 4000 .f1 COMPOUND_TEXT 16000 4000 .f1 COMPOUND_TEXT 0 4000 .f1 COMPOUND_TEXT 4000 4000}} \ ! {{selection owner didn't respond} {.f1 STRING 0 4000 .f1 STRING 4000 4000 .f1 STRING 8000 4000 .f1 STRING 12000 4000 .f1 STRING 16000 4000 .f1 STRING 0 4000 .f1 STRING 4000 4000}}] ############################################################################## *************** *** 975,987 **** setupbg set selValue $longValue set selInfo "" ! selection handle .f1 {badHandler .f1 STRING} set result "" set abortCount 2 lappend result [dobg {selection get}] cleanupbg lappend result $selInfo ! } {{PRIMARY selection doesn't exist or form "STRING" not defined} {.f1 STRING 0 4000 .f1 STRING 4000 4000}} catch {rename weirdHandler {}} concat --- 1011,1029 ---- setupbg set selValue $longValue set selInfo "" ! if {[info commands kanji] == "kanji"} { ! selection handle .f1 {badHandler .f1 COMPOUND_TEXT} ! } else { ! selection handle .f1 {badHandler .f1 STRING} ! } set result "" set abortCount 2 lappend result [dobg {selection get}] cleanupbg lappend result $selInfo ! } [jp&orig \ ! {{PRIMARY selection doesn't exist or form "COMPOUND_TEXT" not defined} {.f1 COMPOUND_TEXT 0 4000 .f1 COMPOUND_TEXT 4000 4000}} \ ! {{PRIMARY selection doesn't exist or form "STRING" not defined} {.f1 STRING 0 4000 .f1 STRING 4000 4000}}] catch {rename weirdHandler {}} concat diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/tests/text.test ./tests/text.test *** ../tk4.2/tests/text.test Tue Aug 27 05:27:03 1996 --- ./tests/text.test Fri Oct 18 13:15:19 1996 *************** *** 109,115 **** lappend result [lindex $i 4] } set result ! } {blue {} {} 7 watch 0 {} fixed #012 5 #123 #234 0 green 45 100 47 2 3 82 raised #ffff01234567 21 yellow 0 0 0 0 disabled {1i 2i 3i 4i} {any old thing} 73 word {x scroll command} {test command}} test text-2.1 {Tk_TextCmd procedure} { list [catch {text} msg] $msg --- 109,117 ---- lappend result [lindex $i 4] } set result ! } [jp&orig \ ! {blue {} {} 7 watch 0 {} fixed -misc-fixed-medium-*--14-*-jisx0208.1983-0 #012 5 #123 #234 0 green 45 100 47 2 3 82 raised #ffff01234567 21 yellow 0 0 0 0 disabled {1i 2i 3i 4i} {any old thing} 73 word {x scroll command} {test command}} \ ! {blue {} {} 7 watch 0 {} fixed #012 5 #123 #234 0 green 45 100 47 2 3 82 raised #ffff01234567 21 yellow 0 0 0 0 disabled {1i 2i 3i 4i} {any old thing} 73 word {x scroll command} {test command}}] test text-2.1 {Tk_TextCmd procedure} { list [catch {text} msg] $msg *************** *** 141,147 **** } {1 {wrong # args: should be ".t option ?arg arg ...?"}} test text-3.2 {TextWidgetCmd procedure} { list [catch {.t gorp 1.0 z 1.2} msg] $msg ! } {1 {bad option "gorp": must be bbox, cget, compare, configure, debug, delete, dlineinfo, get, index, insert, mark, scan, search, see, tag, window, xview, or yview}} test text-4.1 {TextWidgetCmd procedure, "bbox" option} { list [catch {.t bbox} msg] $msg --- 143,151 ---- } {1 {wrong # args: should be ".t option ?arg arg ...?"}} test text-3.2 {TextWidgetCmd procedure} { list [catch {.t gorp 1.0 z 1.2} msg] $msg ! } [jp&orig \ ! {1 {bad option "gorp": must be bbox, cget, compare, configure, debug, delete, dlineinfo, get, index, insert, mark, scan, search, see, tag, window, xview, xypos, or yview}} \ ! {1 {bad option "gorp": must be bbox, cget, compare, configure, debug, delete, dlineinfo, get, index, insert, mark, scan, search, see, tag, window, xview, or yview}}] test text-4.1 {TextWidgetCmd procedure, "bbox" option} { list [catch {.t bbox} msg] $msg *************** *** 209,215 **** } {1 {bad comparison operator "z": must be <, <=, ==, >=, >, or !=}} test text-6.14 {TextWidgetCmd procedure, "compare" option} { list [catch {.t co 1.0 z 1.2} msg] $msg ! } {1 {bad option "co": must be bbox, cget, compare, configure, debug, delete, dlineinfo, get, index, insert, mark, scan, search, see, tag, window, xview, or yview}} # "configure" option is already covered above --- 213,221 ---- } {1 {bad comparison operator "z": must be <, <=, ==, >=, >, or !=}} test text-6.14 {TextWidgetCmd procedure, "compare" option} { list [catch {.t co 1.0 z 1.2} msg] $msg ! } [jp&orig \ ! {1 {bad option "co": must be bbox, cget, compare, configure, debug, delete, dlineinfo, get, index, insert, mark, scan, search, see, tag, window, xview, xypos, or yview}} \ ! {1 {bad option "co": must be bbox, cget, compare, configure, debug, delete, dlineinfo, get, index, insert, mark, scan, search, see, tag, window, xview, or yview}}] # "configure" option is already covered above *************** *** 218,224 **** } {1 {wrong # args: should be ".t debug boolean"}} test text-7.2 {TextWidgetCmd procedure, "debug" option} { list [catch {.t de 0 1} msg] $msg ! } {1 {bad option "de": must be bbox, cget, compare, configure, debug, delete, dlineinfo, get, index, insert, mark, scan, search, see, tag, window, xview, or yview}} test text-7.3 {TextWidgetCmd procedure, "debug" option} { .t debug true .t deb --- 224,232 ---- } {1 {wrong # args: should be ".t debug boolean"}} test text-7.2 {TextWidgetCmd procedure, "debug" option} { list [catch {.t de 0 1} msg] $msg ! } [jp&orig \ ! {1 {bad option "de": must be bbox, cget, compare, configure, debug, delete, dlineinfo, get, index, insert, mark, scan, search, see, tag, window, xview, xypos, or yview}} \ ! {1 {bad option "de": must be bbox, cget, compare, configure, debug, delete, dlineinfo, get, index, insert, mark, scan, search, see, tag, window, xview, or yview}}] test text-7.3 {TextWidgetCmd procedure, "debug" option} { .t debug true .t deb *************** *** 301,307 **** } {1 {wrong # args: should be ".t index index"}} test text-10.3 {TextWidgetCmd procedure, "index" option} { list [catch {.t in a b} msg] $msg ! } {1 {bad option "in": must be bbox, cget, compare, configure, debug, delete, dlineinfo, get, index, insert, mark, scan, search, see, tag, window, xview, or yview}} test text-10.4 {TextWidgetCmd procedure, "index" option} { list [catch {.t index @xyz} msg] $msg } {1 {bad text index "@xyz"}} --- 309,317 ---- } {1 {wrong # args: should be ".t index index"}} test text-10.3 {TextWidgetCmd procedure, "index" option} { list [catch {.t in a b} msg] $msg ! } [jp&orig \ ! {1 {bad option "in": must be bbox, cget, compare, configure, debug, delete, dlineinfo, get, index, insert, mark, scan, search, see, tag, window, xview, xypos, or yview}} \ ! {1 {bad option "in": must be bbox, cget, compare, configure, debug, delete, dlineinfo, get, index, insert, mark, scan, search, see, tag, window, xview, or yview}}] test text-10.4 {TextWidgetCmd procedure, "index" option} { list [catch {.t index @xyz} msg] $msg } {1 {bad text index "@xyz"}} *************** *** 446,452 **** set result [selection get] .t2 configure -exportselection 0 lappend result [catch {selection get} msg] $msg ! } {1234 1 {PRIMARY selection doesn't exist or form "STRING" not defined}} test text-12.16 {ConfigureText procedure} {fonts} { # This test is non-portable because the window size will vary depending # on the font size, which can vary. --- 456,464 ---- set result [selection get] .t2 configure -exportselection 0 lappend result [catch {selection get} msg] $msg ! } [jp&orig \ ! {1234 1 {PRIMARY selection doesn't exist or form "COMPOUND_TEXT" not defined}} \ ! {1234 1 {PRIMARY selection doesn't exist or form "STRING" not defined}}] test text-12.16 {ConfigureText procedure} {fonts} { # This test is non-portable because the window size will vary depending # on the font size, which can vary. diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/tests/textDisp.test ./tests/textDisp.test *** ../tk4.2/tests/textDisp.test Fri Sep 6 01:56:52 1996 --- ./tests/textDisp.test Fri Oct 18 13:15:20 1996 *************** *** 45,52 **** puts "going to skip the tests." return } pack append . .t {top expand fill} ! .t tag configure big -font $bigFont .t debug on wm geometry . {} --- 45,59 ---- puts "going to skip the tests." return } + if {[info commands kanji] == "kanji"} { + .t configure -kanjifont $fixedFont + } pack append . .t {top expand fill} ! if {[info commands kanji] == "kanji"} { ! .t tag configure big -font $bigFont -kanjifont $bigFont ! } else { ! .t tag configure big -font $bigFont ! } .t debug on wm geometry . {} *************** *** 2775,2780 **** --- 2782,2791 ---- update lappend result [.t2.t index @0,0] } {6.0 1.0} + + if {[info commands kanji] == "kanji"} { + option add *Text.kanjiFont "$fixedFont" + } test textDisp-29.1 {miscellaneous: lines wrap but are still too long} {fonts} { catch {destroy .t2} diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/tests/textWind.test ./tests/textWind.test *** ../tk4.2/tests/textWind.test Tue Aug 27 02:08:00 1996 --- ./tests/textWind.test Fri Oct 18 13:15:20 1996 *************** *** 22,27 **** --- 22,30 ---- puts "going to skip the tests." return } + if {[info commands kanji] == "kanji"} { + .t configure -kanjifont -adobe-courier-medium-r-normal--12-120-75-75-m-70-iso8859-1 + } pack append . .t {top expand fill} update .t debug on diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/tests/winClipboard.test ./tests/winClipboard.test *** ../tk4.2/tests/winClipboard.test Tue Oct 8 03:37:48 1996 --- ./tests/winClipboard.test Fri Oct 18 14:30:42 1996 *************** *** 21,27 **** clipboard clear catch {selection get -selection CLIPBOARD} msg set msg ! } {CLIPBOARD selection doesn't exist or form "STRING" not defined} test winClipboard-1.2 {TkSelGetSelection} {pcOnly} { clipboard clear clipboard append {} --- 21,29 ---- clipboard clear catch {selection get -selection CLIPBOARD} msg set msg ! } [jp&orig \ ! {CLIPBOARD selection doesn't exist or form "COMPOUND_TEXT" not defined} \ ! {CLIPBOARD selection doesn't exist or form "STRING" not defined}] test winClipboard-1.2 {TkSelGetSelection} {pcOnly} { clipboard clear clipboard append {} diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/unix/Makefile.in ./unix/Makefile.in *** ../tk4.2/unix/Makefile.in Thu Oct 17 01:27:57 1996 --- ./unix/Makefile.in Fri Oct 18 13:31:50 1996 *************** *** 117,123 **** # *everywhere*, including all the code that calls Tcl, and you must use # ckalloc and ckfree everywhere instead of malloc and free. MEM_DEBUG_FLAGS = ! #MEM_DEBUG_FLAGS = -DTCL_MEM_DEBUG # If your X server is X11R4 or earlier, then you may wish to reverse # the comment characters on the following two lines. This will enable --- 117,131 ---- # *everywhere*, including all the code that calls Tcl, and you must use # ckalloc and ckfree everywhere instead of malloc and free. MEM_DEBUG_FLAGS = ! # MEM_DEBUG_FLAGS = -DTCL_MEM_DEBUG ! ! # To disable kanji handling, reverse the comment characters on the following ! # lines. `KINPUT2' is the name of kanji input server. Actually, `KINPUT2' ! # is the only kanji input server you can choose right now. :-) ! # Warning: if you enable kanji handling for tk, you must enable kanji ! # handling for tcl. ! KANJI_FLAGS = -DKANJI -DKINPUT2 ! # KANJI_FLAGS = # If your X server is X11R4 or earlier, then you may wish to reverse # the comment characters on the following two lines. This will enable *************** *** 180,191 **** CC = @CC@ CC_SWITCHES = ${CFLAGS} ${TK_SHLIB_CFLAGS} -I${UNIX_DIR} -I${GENERIC_DIR} \ -I${BMAP_DIR} -I${TCL_GENERIC_DIR} ${X11_INCLUDES} ${AC_FLAGS} ${PROTO_FLAGS} \ ! ${SECURITY_FLAGS} ${MEM_DEBUG_FLAGS} ${KEYSYM_FLAGS} DEPEND_SWITCHES = ${CFLAGS} -I${UNIX_DIR} -I${GENERIC_DIR} \ -I${BMAP_DIR} \ -I${TCL_GENERIC_DIR} ${X11_INCLUDES} \ ! ${AC_FLAGS} ${PROTO_FLAGS} ${SECURITY_FLAGS} ${MEM_DEBUG_FLAGS} \ ${KEYSYM_FLAGS} WISH_OBJS = tkAppInit.o --- 188,199 ---- CC = @CC@ CC_SWITCHES = ${CFLAGS} ${TK_SHLIB_CFLAGS} -I${UNIX_DIR} -I${GENERIC_DIR} \ -I${BMAP_DIR} -I${TCL_GENERIC_DIR} ${X11_INCLUDES} ${AC_FLAGS} ${PROTO_FLAGS} \ ! ${SECURITY_FLAGS} ${MEM_DEBUG_FLAGS} ${KANJI_FLAGS} ${KEYSYM_FLAGS} DEPEND_SWITCHES = ${CFLAGS} -I${UNIX_DIR} -I${GENERIC_DIR} \ -I${BMAP_DIR} \ -I${TCL_GENERIC_DIR} ${X11_INCLUDES} \ ! ${AC_FLAGS} ${PROTO_FLAGS} ${SECURITY_FLAGS} ${MEM_DEBUG_FLAGS} ${KANJI_FLAGS} \ ${KEYSYM_FLAGS} WISH_OBJS = tkAppInit.o *************** *** 208,220 **** UNIXOBJS = tkUnix.o tkUnixCursor.o tkUnixDialog.o tkUnixDraw.o tkUnixEvent.o \ tkUnixInit.o tkUnixSelect.o tkUnixWm.o tkUnixXId.o OBJS = tk3d.o tkArgv.o tkAtom.o tkBind.o tkBitmap.o tkClipboard.o tkCmds.o \ tkColor.o tkConfig.o tkCursor.o tkError.o tkEvent.o \ tkFocus.o tkFont.o tkGet.o tkGC.o tkGeometry.o tkGrab.o tkGrid.o \ tkMain.o tkOption.o tkPack.o tkPlace.o \ tkSelect.o tkSend.o tkUtil.o tkVisual.o \ tkWindow.o \ ! $(UNIXOBJS) $(WIDGOBJS) $(CANVOBJS) $(IMAGEOBJS) $(TEXTOBJS) SRCS = \ $(GENERIC_DIR)/tk3d.c $(GENERIC_DIR)/tkArgv.c \ --- 216,235 ---- UNIXOBJS = tkUnix.o tkUnixCursor.o tkUnixDialog.o tkUnixDraw.o tkUnixEvent.o \ tkUnixInit.o tkUnixSelect.o tkUnixWm.o tkUnixXId.o + KANJIOBJS = tkWStr.o tkKinput2.o tkCtext.o + OBJS = tk3d.o tkArgv.o tkAtom.o tkBind.o tkBitmap.o tkClipboard.o tkCmds.o \ tkColor.o tkConfig.o tkCursor.o tkError.o tkEvent.o \ tkFocus.o tkFont.o tkGet.o tkGC.o tkGeometry.o tkGrab.o tkGrid.o \ tkMain.o tkOption.o tkPack.o tkPlace.o \ tkSelect.o tkSend.o tkUtil.o tkVisual.o \ tkWindow.o \ ! $(UNIXOBJS) $(WIDGOBJS) $(CANVOBJS) $(IMAGEOBJS) $(TEXTOBJS) \ ! $(KANJIOBJS) ! ! KANJISRCS = \ ! $(GENERIC_DIR)/tkWStr.c $(GENERIC_DIR)/tkCtext.c \ ! $(UNIX_DIR)/tkKinput2.c SRCS = \ $(GENERIC_DIR)/tk3d.c $(GENERIC_DIR)/tkArgv.c \ *************** *** 256,262 **** $(UNIX_DIR)/tkUnixDialog.c $(UNIX_DIR)/tkUnixDraw.c \ $(UNIX_DIR)/tkUnixEvent.c $(UNIX_DIR)/tkUnixInit.c \ $(UNIX_DIR)/tkUnixSelect.c $(UNIX_DIR)/tkUnixWm.c \ ! $(UNIX_DIR)/tkUnixXId.c HDRS = bltList.h \ default.h ks_names.h tkPatch.h tk.h tkCanvas.h tkInt.h \ --- 271,279 ---- $(UNIX_DIR)/tkUnixDialog.c $(UNIX_DIR)/tkUnixDraw.c \ $(UNIX_DIR)/tkUnixEvent.c $(UNIX_DIR)/tkUnixInit.c \ $(UNIX_DIR)/tkUnixSelect.c $(UNIX_DIR)/tkUnixWm.c \ ! $(UNIX_DIR)/tkUnixXId.c $(KANJISRCS) ! ! KANJIHDRS = tkWStr.h tkKinput2.h $(KANJIHDRS) HDRS = bltList.h \ default.h ks_names.h tkPatch.h tk.h tkCanvas.h tkInt.h \ *************** *** 654,659 **** --- 671,685 ---- tkUnixWm.o: $(UNIX_DIR)/tkUnixWm.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixWm.c + + tkWStr.o: $(GENERIC_DIR)/tkWStr.c + $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkWStr.c + + tkCtext.o: $(GENERIC_DIR)/tkCtext.c + $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkCtext.c + + tkKinput2.o: $(UNIX_DIR)/tkKinput2.c + $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkKinput2.c tkUnixXId.o: $(UNIX_DIR)/tkUnixXId.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixXId.c diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/unix/configure ./unix/configure *** ../tk4.2/unix/configure Thu Oct 17 01:27:57 1996 --- ./unix/configure Fri Oct 18 13:32:25 1996 *************** *** 408,414 **** # SCCS: @(#) configure.in 1.68 96/10/02 14:04:05 ! TK_VERSION=4.2 TK_MAJOR_VERSION=4 TK_MINOR_VERSION=2 VERSION=${TK_VERSION} --- 408,414 ---- # SCCS: @(#) configure.in 1.68 96/10/02 14:04:05 ! TK_VERSION=4.2jp TK_MAJOR_VERSION=4 TK_MINOR_VERSION=2 VERSION=${TK_VERSION} diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/unix/configure.in ./unix/configure.in *** ../tk4.2/unix/configure.in Thu Oct 17 01:27:58 1996 --- ./unix/configure.in Fri Oct 18 13:32:06 1996 *************** *** 4,10 **** AC_INIT(../generic/tk.h) # SCCS: @(#) configure.in 1.68 96/10/02 14:04:05 ! TK_VERSION=4.2 TK_MAJOR_VERSION=4 TK_MINOR_VERSION=2 VERSION=${TK_VERSION} --- 4,10 ---- AC_INIT(../generic/tk.h) # SCCS: @(#) configure.in 1.68 96/10/02 14:04:05 ! TK_VERSION=4.2jp TK_MAJOR_VERSION=4 TK_MINOR_VERSION=2 VERSION=${TK_VERSION} diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/unix/tkKinput2.c ./unix/tkKinput2.c *** ../tk4.2/unix/tkKinput2.c Thu Jan 1 09:00:00 1970 --- ./unix/tkKinput2.c Fri Oct 18 13:15:22 1996 *************** *** 0 **** --- 1,1756 ---- + /* + * tkKinput2.c -- + * + * This file contains modules to implement the kanji + * input with kinput2. + * + * Copyright 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/tk/unix/tkKinput2.c,v 1.3 1996/07/05 02:14:09 nisinaka Exp $"; + #endif + + #if defined(KANJI) && defined(KINPUT2) + + #include "tkPort.h" + #include "tkInt.h" + + /* + * For each kinput2 server, there is a structure of the following type: + */ + + typedef struct { + int specified; + char *value; + } KI2Attr; + + typedef struct { + char *variable; + int num; + KI2Attr inputStyle; + KI2Attr focusWindow; + KI2Attr spot; + KI2Attr foreground; + KI2Attr background; + KI2Attr eventCaptureMethod; + KI2Attr lineSpacing; + KI2Attr clientArea; + KI2Attr statusArea; + KI2Attr cursor; + KI2Attr fonts; + } Kinput2Info; + + /* + * Atoms used in this module. (Japanese conversion only) + */ + + static Atom japanese_conversion_atom; + static Atom compound_text_atom; + + /* + * Have atoms in this module been initialized? + */ + + static int atom_initialized = 0; + + /* + * Information about the current server. (Assuming only one server) + */ + + static Tcl_HashTable ki2infoTable; + static int ki2_initialized = 0; + + /* + * Forward declarations for procedures defined later in this file: + */ + + static void Kinput2InfoInit _ANSI_ARGS_ ((void)); + static void Kinput2InputString _ANSI_ARGS_ ((Tcl_Interp *interp, + Tk_Window tkwin, Atom selection, Atom type, + int format, unsigned long size, unsigned char *str, + ClientData clientData)); + static void Kinput2StartendProc _ANSI_ARGS_ ((Tcl_Interp *interp, + Tk_Window tkwin, Atom selection, int state, + ClientData clientData)); + static void beginConversion _ANSI_ARGS_ ((Tcl_Interp *interp, + Tk_Window tkwin, Atom catom, Atom tatom, + void (*inputproc)(), void (*startendproc)(), + ClientData clientData, Kinput2Info *ki2Ptr)); + static void endConversion _ANSI_ARGS_ ((Tcl_Interp *interp, + Tk_Window tkwin, Atom catom, int throwaway)); + static void changeConversionAttributes _ANSI_ARGS_ ((Tcl_Interp *interp, + Tk_Window tkwin, Atom catom, Kinput2Info *ki2Ptr)); + static int parseAttributes _ANSI_ARGS_ ((Tcl_Interp *interp, + int argc, char **argv, Kinput2Info *ki2Ptr)); + static char * formatAttributeInfo _ANSI_ARGS_ ((Kinput2Info *ki2Ptr, + char *attrName)); + + /* + *-------------------------------------------------------------- + * + * Tk_Kinput2Start -- + * + * This procedure is invoked to start the kanji conversion + * using kinput2. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *-------------------------------------------------------------- + */ + + int + Tk_Kinput2Start(interp, tkwin, argc, argv) + Tcl_Interp *interp; /* Current interpreter. */ + Tk_Window tkwin; /* Focus window. */ + int argc; /* Number of arguments. */ + char **argv; /* Argument strings. */ + { + Tcl_HashEntry *ki2infoHashPtr; + int new; + register Kinput2Info *ki2Ptr; + char *variable = NULL; + + if (!atom_initialized) { + japanese_conversion_atom = Tk_InternAtom(tkwin, "_JAPANESE_CONVERSION"); + compound_text_atom = Tk_InternAtom(tkwin, "COMPOUND_TEXT"); + atom_initialized = 1; + } + if (!ki2_initialized) Kinput2InfoInit(); + + /* + * Get the Kinput2Info for the focus window. + */ + + ki2infoHashPtr = Tcl_CreateHashEntry(&ki2infoTable, (char *) tkwin, &new); + if (!new) { + ki2Ptr = (Kinput2Info *) Tcl_GetHashValue(ki2infoHashPtr); + } else { + ki2Ptr = (Kinput2Info *) ckalloc(sizeof(Kinput2Info)); + ki2Ptr->variable = NULL; + ki2Ptr->num = 0; + ki2Ptr->inputStyle.specified = None; + ki2Ptr->inputStyle.value = NULL; + ki2Ptr->focusWindow.specified = None; + ki2Ptr->focusWindow.value = NULL; + ki2Ptr->spot.specified = None; + ki2Ptr->spot.value = NULL; + ki2Ptr->foreground.specified = None; + ki2Ptr->foreground.value = NULL; + ki2Ptr->background.specified = None; + ki2Ptr->background.value = NULL; + ki2Ptr->eventCaptureMethod.specified = None; + ki2Ptr->eventCaptureMethod.value = NULL; + ki2Ptr->lineSpacing.specified = None; + ki2Ptr->lineSpacing.value = NULL; + ki2Ptr->clientArea.specified = None; + ki2Ptr->clientArea.value = NULL; + ki2Ptr->statusArea.specified = None; + ki2Ptr->statusArea.value = NULL; + ki2Ptr->cursor.specified = None; + ki2Ptr->cursor.value = NULL; + ki2Ptr->fonts.specified = None; + ki2Ptr->fonts.value = NULL; + + Tcl_SetHashValue(ki2infoHashPtr, ki2Ptr); + } + + /* + * Parse the arguments and update the Kinput2Info. + */ + + if (parseAttributes(interp, argc, argv, ki2Ptr) == TCL_ERROR) { + return TCL_ERROR; + } + + if (ki2Ptr->variable) { + variable = (char *) ckalloc((unsigned)(strlen(ki2Ptr->variable) + 1)); + strcpy(variable, ki2Ptr->variable); + } + + beginConversion(interp, tkwin, japanese_conversion_atom, compound_text_atom, + Kinput2InputString, Kinput2StartendProc, (ClientData) variable, ki2Ptr); + + return (strlen(interp->result) == 0) ? TCL_OK : TCL_ERROR; + } + + /* + *-------------------------------------------------------------- + * + * Tk_Kinput2End -- + * + * This procedure is invoked to end the kanji conversion + * using kinput2. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *-------------------------------------------------------------- + */ + + int + Tk_Kinput2End(interp, tkwin) + Tcl_Interp *interp; /* Current interpreter. */ + Tk_Window tkwin; /* Focus window.*/ + { + if (!atom_initialized) { + Tcl_SetResult(interp, "kanjiInput is never started.", TCL_VOLATILE); + return TCL_ERROR; + } + + endConversion(interp, tkwin, japanese_conversion_atom, True); + + return (strlen(interp->result) == 0) ? TCL_OK : TCL_ERROR; + } + + /* + *-------------------------------------------------------------- + * + * Tk_Kinput2Attribute -- + * + * This procedure is invoked to change the attributes for + * the kanji conversion using kinput2. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *-------------------------------------------------------------- + */ + + int + Tk_Kinput2Attribute(interp, tkwin, argc, argv) + Tcl_Interp *interp; /* Current interpreter. */ + Tk_Window tkwin; /* Focus window. */ + int argc; /* Number of arguments. */ + char **argv; /* Argument strings. */ + { + Tcl_HashEntry *ki2infoHashPtr; + register Kinput2Info *ki2Ptr; + int saved1, saved2; + + if (!ki2_initialized) { + Tcl_SetResult(interp, "kanjiInput is never started.", TCL_VOLATILE); + return TCL_ERROR; + } + + ki2infoHashPtr = Tcl_FindHashEntry(&ki2infoTable, (char *) tkwin); + if (ki2infoHashPtr == NULL) { + Tcl_SetResult(interp, + "No hash entry: kanjiInput 'attribute' is invoked before 'start'", + TCL_VOLATILE); + return TCL_ERROR; + } + ki2Ptr = (Kinput2Info *) Tcl_GetHashValue(ki2infoHashPtr); + + /* + * Parse the arguments and update the Kinput2Info. + */ + + if (parseAttributes(interp, argc, argv, ki2Ptr) == TCL_ERROR) { + return TCL_ERROR; + } + saved1 = ki2Ptr->inputStyle.specified; + saved2 = ki2Ptr->eventCaptureMethod.specified; + ki2Ptr->inputStyle.specified = None; + ki2Ptr->eventCaptureMethod.specified = None; + + changeConversionAttributes(interp, tkwin, japanese_conversion_atom, ki2Ptr); + + ki2Ptr->inputStyle.specified = saved1; + ki2Ptr->eventCaptureMethod.specified = saved2; + + return (strlen(interp->result) == 0) ? TCL_OK : TCL_ERROR; + } + + /* + *-------------------------------------------------------------- + * + * Tk_Kinput2AttributeInfo -- + * + * This procedure is invoked to show the attributes for + * the kanji conversion using kinput2. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *-------------------------------------------------------------- + */ + + int + Tk_Kinput2AttributeInfo(interp, tkwin, attrName) + Tcl_Interp *interp; /* Current interpreter. */ + Tk_Window tkwin; /* Window to focus. */ + char *attrName; /* If non-NULL, indicates a single option + * whose info is to be returned. Otherwise + * info is returned for all options. */ + { + Tcl_HashEntry *ki2infoHashPtr; + register Kinput2Info *ki2Ptr; + char *list; + + if (!ki2_initialized) { + Tcl_SetResult(interp, "kanjiInput is never started.", TCL_VOLATILE); + return TCL_ERROR; + } + + ki2infoHashPtr = Tcl_FindHashEntry(&ki2infoTable, (char *) tkwin); + if (ki2infoHashPtr == NULL) { + Tcl_SetResult(interp, + "No hash entry: kanjiInput 'attribute' is invoked before 'start'", + TCL_VOLATILE); + return TCL_ERROR; + } + ki2Ptr = (Kinput2Info *) Tcl_GetHashValue(ki2infoHashPtr); + + /* + * Create a valid Tcl list holding the attributes of the kinput2. + */ + + Tcl_SetResult(interp, (char *) NULL, TCL_STATIC); + + if (attrName != NULL) { + list = formatAttributeInfo(ki2Ptr, attrName); + if (list == NULL) { + Tcl_AppendResult(interp, "unknown attribute \"", attrName, "\"", + (char *) NULL); + return TCL_ERROR; + } + interp->result = list; + interp->freeProc = TCL_DYNAMIC; + } else { + list = formatAttributeInfo(ki2Ptr, "-variable"); + Tcl_AppendResult(interp, "{", list, "}", (char *) NULL); + ckfree(list); + list = formatAttributeInfo(ki2Ptr, "-inputStyle"); + Tcl_AppendResult(interp, " {", list, "}", (char *) NULL); + ckfree(list); + list = formatAttributeInfo(ki2Ptr, "-focusWindow"); + Tcl_AppendResult(interp, " {", list, "}", (char *) NULL); + ckfree(list); + list = formatAttributeInfo(ki2Ptr, "-spot"); + Tcl_AppendResult(interp, " {", list, "}", (char *) NULL); + ckfree(list); + list = formatAttributeInfo(ki2Ptr, "-foreground"); + Tcl_AppendResult(interp, " {", list, "}", (char *) NULL); + ckfree(list); + list = formatAttributeInfo(ki2Ptr, "-background"); + Tcl_AppendResult(interp, " {", list, "}", (char *) NULL); + ckfree(list); + list = formatAttributeInfo(ki2Ptr, "-eventCaptureMethod"); + Tcl_AppendResult(interp, " {", list, "}", (char *) NULL); + ckfree(list); + list = formatAttributeInfo(ki2Ptr, "-lineSpacing"); + Tcl_AppendResult(interp, " {", list, "}", (char *) NULL); + ckfree(list); + list = formatAttributeInfo(ki2Ptr, "-clientArea"); + Tcl_AppendResult(interp, " {", list, "}", (char *) NULL); + ckfree(list); + list = formatAttributeInfo(ki2Ptr, "-statusArea"); + Tcl_AppendResult(interp, " {", list, "}", (char *) NULL); + ckfree(list); + list = formatAttributeInfo(ki2Ptr, "-cursor"); + Tcl_AppendResult(interp, " {", list, "}", (char *) NULL); + ckfree(list); + list = formatAttributeInfo(ki2Ptr, "-fonts"); + Tcl_AppendResult(interp, " {", list, "}", (char *) NULL); + ckfree(list); + } + + return TCL_OK; + } + + /* + *---------------------------------------------------------------------- + * + * Kinput2InfoInit -- + * + * Initialize the structures used for Kinput2Info management. + * + * Results: + * None. + * + * Side effects: + * Read the code. + * + *---------------------------------------------------------------------- + */ + + static void + Kinput2InfoInit() + { + ki2_initialized = 1; + Tcl_InitHashTable(&ki2infoTable, TCL_ONE_WORD_KEYS); + } + + /* + *-------------------------------------------------------------- + * + * Kinput2InputString -- + * + * This procedure is invoked when the application receives + * the kanji string from kinput2 server. + * + * Results: + * None. + * + * Side effects: + * See the user documentation. + * + *-------------------------------------------------------------- + */ + + static void + Kinput2InputString(interp, tkwin, selection, type, format, size, str, clientData) + Tcl_Interp *interp; + Tk_Window tkwin; + Atom selection; + Atom type; + int format; + unsigned long size; + unsigned char *str; + ClientData clientData; + { + if (str == NULL) { + return; + } else { + int kanjiCode = Tcl_KanjiCode(interp); + char *variable = (char *) clientData; + int len; + wchar *wstr; + char *kanjiStr; + + if (variable == NULL) return; + + wstr = Tk_CtextToWStr(str, size); + if (wstr == NULL) return; + + len = Tcl_KanjiDecode(kanjiCode, wstr, NULL); + kanjiStr = (char *) ckalloc((unsigned)(len + 1)); + (void) Tcl_KanjiDecode(kanjiCode, wstr, kanjiStr); + + Tcl_SetVar(interp, variable, kanjiStr, TCL_GLOBAL_ONLY); + + ckfree((char *)wstr); + ckfree(kanjiStr); + } + } + + /* + *-------------------------------------------------------------- + * + * Kinput2StartendProc -- + * + * This procedure is invoked when a conversion starts, ends, + * or aborts. + * + * Results: + * None. + * + * Side effects: + * See the user documentation. + * + *-------------------------------------------------------------- + */ + + static void + Kinput2StartendProc(interp, tkwin, selection, state, clientData) + Tcl_Interp *interp; + Tk_Window tkwin; + Atom selection; + int state; + ClientData clientData; + { + switch (state) { + case 0: /* start */ + break; + case 1: /* end */ + /* fall through */ + default: /* error */ + /* free memory for the variable name */ + if (clientData != NULL) ckfree((char *)clientData); + } + } + + /* + * Procedures for kanji conversion with kinput2. + */ + + #include "tkKinput2.h" + + typedef struct { + Display *display; + Atom profileAtom; /* "_CONVERSION_PROFILE" */ + Atom typeAtom; /* "_CONVERSION_ATTRIBUTE_TYPE" */ + Atom versionAtom; /* "PROTOCOL-2.0" */ + Atom reqAtom; /* "CONVERSION_REQUEST" */ + Atom notifyAtom; /* "CONVERSION_NOTIFY" */ + Atom endAtom; /* "CONVERSION_END" */ + Atom endReqAtom; /* "CONVERSION_END_REQUEST" */ + Atom attrAtom; /* "CONVERSION_ATTRIBUTE" */ + Atom attrNotifyAtom; /* "CONVERSION_ATTRIBUTE_NOTIFY" */ + } ConversionAtoms; + + typedef struct { + Tcl_Interp *interp; + Tk_Window tkwin; + Atom convatom; + Window convowner; + Window forwardwin; + Atom property; + void (*inputproc)(); + void (*startendproc)(); + ClientData clientData; + } ConversionContext; + + static XContext convertPrivContext; + + /* + * Forward declarations for procedures defined later in this file: + */ + + static void finishConversion _ANSI_ARGS_ ((Tk_Window tkwin, + ConversionContext *context)); + static int recvConvAck _ANSI_ARGS_((ClientData clientData, + XEvent *eventPtr)); + static int getConv _ANSI_ARGS_((ClientData clientData, + XEvent *eventPtr)); + static void callStart _ANSI_ARGS_((Tk_Window tkwin, + ConversionContext *context)); + static void callFail _ANSI_ARGS_((Tk_Window tkwin, + ConversionContext *context)); + static void callEnd _ANSI_ARGS_((Tk_Window tkwin, + ConversionContext *context)); + static ConversionAtoms *getAtoms _ANSI_ARGS_ ((Tk_Window tkwin)); + static ConversionContext *getConversionContext _ANSI_ARGS_ ((Tk_Window tkwin)); + static int makeAttrData _ANSI_ARGS_ ((Tcl_Interp *interp, + Tk_Window tkwin, Kinput2Info *ki2Ptr, + unsigned long **datap)); + static void forwardKeyEvent _ANSI_ARGS_ ((ClientData clientdata, + XEvent *event)); + static int stopForwarding _ANSI_ARGS_ ((ClientData clientdata, + XErrorEvent *errEvent)); + + /* + *-------------------------------------------------------------- + * + * beginConversion -- + * + * Find a kanji conversion server and invoke it. + * + * Results: + * None. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + + static void + beginConversion(interp, tkwin, catom, tatom, inputproc, startendproc, clientData, ki2Ptr) + Tcl_Interp *interp; + Tk_Window tkwin; + Atom catom; /* Selection Atom e.g. JAPANESE_CONVERSION */ + Atom tatom; /* Property Type Atom e.g. COMPOUND_TEXT */ + void (*inputproc)(); /* conversion text callback function */ + void (*startendproc)(); /* conversion start/end callback function */ + ClientData clientData; /* client_data passed to callback function */ + Kinput2Info *ki2Ptr; + { + Window owner; + XEvent event; + ConversionAtoms *cap; + ConversionContext *context; + int anyattr = False; + static int checkProtocols _ANSI_ARGS_ ((Display *dpy, + Window window, ConversionAtoms *cap)); + + cap = getAtoms(tkwin); + + /* 変換サーバを探す */ + if ((owner = XGetSelectionOwner(Tk_Display(tkwin), catom)) == None) { + /* ない + * もしも変換中だったら変換を中止する + */ + Tcl_SetResult(interp, "Conversion Server not found", TCL_VOLATILE); + if ((context = getConversionContext(tkwin)) != NULL) { + callEnd(tkwin, context); + finishConversion(tkwin, context); + ckfree((char *)context); + } + return; + } + + /* + * 今すでに変換中かどうか調べる + * 変換中なら何もせずにリターンする…わけにはいかない + * なぜかというと、変換サーバが何らかの事情で途中で死んだ場合 + * CONVERSION_END がクライアントに来ないことがあるからである + * そこで、変換中の場合でも SelectionOwner を探して、それが + * 最初に _beginConversion() が呼ばれた時と WindowID が同じか + * どうか確認する + * 本当は SelectionOwner になった時間もチェックしたいのだが + * ICCCM に述べられているように、GetSelectionOwner では + * それがわからないのであきらめる + */ + if ((context = getConversionContext(tkwin)) != NULL) { + Window curOwner; + curOwner = (catom == context->convatom) ? owner : + XGetSelectionOwner(Tk_Display(tkwin), context->convatom); + if (curOwner == context->convowner) { + /* 何もせずにリターン */ + return; + } + /* SelectionOwner が変わっている + * これは途中で変換サーバがクラッシュしたに違いない + * ということで CONVERSION_END が来た時と同じような + * 処理をする + */ + callEnd(tkwin, context); + finishConversion(tkwin, context); + ckfree((char *)context); + } + + /* + * サーバからの CONVERSION_NOTIFY 用のイベントハンドラを + * 登録する + */ + Tk_CreateGenericHandler((Tk_GenericProc *)recvConvAck, (ClientData)tkwin); + + /* + * コンテキストをつくって必要な情報を登録する + */ + context = (ConversionContext *) ckalloc((unsigned)sizeof(ConversionContext)); + context->interp = interp; + context->tkwin = tkwin; + context->convatom = catom; + context->convowner = owner; + context->forwardwin = None; + context->property = None; /* これは CONVERSION_NOTIFY が来た時に + * 正しく設定される */ + context->inputproc = inputproc; + context->startendproc = startendproc; + context->clientData = clientData; + XSaveContext(Tk_Display(tkwin), Tk_WindowId(tkwin), + convertPrivContext, (caddr_t)context); + + /* + * 変換属性リストが指定されていればプロパティにそれを登録する + */ + if (ki2Ptr->num > 0 && checkProtocols(Tk_Display(tkwin), owner, cap)) { + unsigned long *data; + int len; + + if ((len = makeAttrData(interp, tkwin, ki2Ptr, &data)) > 0) { + XChangeProperty(Tk_Display(tkwin), Tk_WindowId(tkwin), + cap->attrAtom, cap->attrAtom, 32, + PropModeReplace, (unsigned char *) data, len); + ckfree((char *) data); + anyattr = True; + } + } + + /* + * ClientMessage イベントを使って日本語入力をリクエストする + */ + event.xclient.type = ClientMessage; + event.xclient.window = owner; + event.xclient.message_type = cap->reqAtom; + event.xclient.format = 32; + event.xclient.data.l[0] = catom; + event.xclient.data.l[1] = Tk_WindowId(tkwin); + event.xclient.data.l[2] = tatom; + /* 結果をストアするプロパティ名は、多言語を同時に使用することを + * 考えて、selection atom を使用することにする + */ + event.xclient.data.l[3] = catom; + event.xclient.data.l[4] = anyattr ? cap->attrAtom : None; + XSendEvent(Tk_Display(tkwin), owner, False, NoEventMask, &event); + } + + /* + *-------------------------------------------------------------- + * + * endConversion -- + * + * Terminate kanji conversion. + * + * Results: + * None. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + + static void + endConversion(interp, tkwin, catom, throwaway) + Tcl_Interp *interp; + Tk_Window tkwin; + Atom catom; /* Selection Atom */ + int throwaway; + { + XEvent event; + ConversionAtoms *cap; + ConversionContext *context; + + cap = getAtoms(tkwin); + context = getConversionContext(tkwin); + + if (context == NULL || (catom != None && catom != context->convatom)) { + return; + } + + if (XGetSelectionOwner(Tk_Display(tkwin), context->convatom) != + context->convowner) { + /* コールバックを呼ぶ */ + callEnd(tkwin, context); + finishConversion(tkwin, context); + ckfree((char *)context); + return; + } + + if (throwaway) context->inputproc = NULL; + + event.xclient.type = ClientMessage; + event.xclient.window = context->convowner; + event.xclient.message_type = cap->endReqAtom; + event.xclient.format = 32; + event.xclient.data.l[0] = context->convatom; + event.xclient.data.l[1] = Tk_WindowId(tkwin); + + XSendEvent(Tk_Display(tkwin), context->convowner, False, NoEventMask, &event); + } + + /* + *-------------------------------------------------------------- + * + * changeConversionAttributes -- + * + * Change attributes of a conversion server. + * + * Results: + * None. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + + static void + changeConversionAttributes(interp, tkwin, catom, ki2Ptr) + Tcl_Interp *interp; + Tk_Window tkwin; + Atom catom; + Kinput2Info *ki2Ptr; + { + XEvent event; + ConversionAtoms *cap; + ConversionContext *context; + unsigned long *data; + int len; + + if (ki2Ptr->num == 0) return; + + cap = getAtoms(tkwin); + context = getConversionContext(tkwin); + + if (context == NULL || (catom != None && catom != context->convatom)) { + return; + } + + if (XGetSelectionOwner(Tk_Display(tkwin), context->convatom) != + context->convowner) { + callEnd(tkwin, context); + finishConversion(tkwin, context); + ckfree((char *)context); + return; + } + + data = NULL; + if ((len = makeAttrData(interp, tkwin, ki2Ptr, &data)) == 0) return; + + event.xclient.type = ClientMessage; + event.xclient.window = context->convowner; + event.xclient.message_type = cap->attrNotifyAtom; + event.xclient.format = 32; + event.xclient.data.l[0] = context->convatom; + event.xclient.data.l[1] = Tk_WindowId(tkwin); + if (len <= 3 && len == LENGTH_OF_ATTR(data[0]) + 1) { + int i; + /* イベントの中に収まる */ + for (i = 0; i < len; i++) { + event.xclient.data.l[2 + i] = data[i]; + } + } else { + XChangeProperty(Tk_Display(tkwin), Tk_WindowId(tkwin), + cap->attrAtom, cap->attrAtom, 32, + PropModeReplace, (unsigned char *)data, len); + event.xclient.data.l[2] = CONV_ATTR(CONVATTR_INDIRECT, 1); + event.xclient.data.l[3] = cap->attrAtom; + } + + XSendEvent(Tk_Display(tkwin), context->convowner, False, NoEventMask, &event); + + if (data != NULL) ckfree((char *)data); + } + + /* + *-------------------------------------------------------------- + * + * parseAttributes -- + * + * Parse attributes. + * + * Results: + * Return TCL_OK if every attributes can be parsed without + * any problems, otherwise return TCL_ERROR. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + + static int + parseAttributes(interp, argc, argv, ki2Ptr) + Tcl_Interp *interp; + int argc; + char **argv; + Kinput2Info *ki2Ptr; + { + int result = TCL_OK; + + ki2Ptr->num = 0; + for ( ; argc > 1; ) { + if (argv[0][0] != '-') { + Tcl_AppendResult(interp, "Warning: expected attribute name, but got \"", + *argv, "\".\n", (char *) NULL); + result = TCL_ERROR; + argv++; + argc--; + continue; + } else { + char c; + int len; + char *name = *argv + 1; + char *value = *(argv + 1); + char *new, *old; + + c = name[0]; + len = strlen(name); + new = (char *) ckalloc((unsigned) (strlen(value) + 1)); + strcpy(new, value); + if ((c == 'b') && (strncmp(name, "background", len) == 0)) { + ki2Ptr->background.specified = !None; + old = ki2Ptr->background.value; + ki2Ptr->background.value = new; + ki2Ptr->num++; + } else if ((c == 'c') && (strncmp(name, "clientArea", len) == 0) + && (len > 1)) { + ki2Ptr->clientArea.specified = !None; + old = ki2Ptr->clientArea.value; + ki2Ptr->clientArea.value = new; + ki2Ptr->num++; + } else if ((c == 'c') && (strncmp(name, "cursor", len) == 0) + && (len > 1)) { + ki2Ptr->cursor.specified = !None; + old = ki2Ptr->cursor.value; + ki2Ptr->cursor.value = new; + ki2Ptr->num++; + } else if ((c == 'e') && (strncmp(name, "eventCaptureMethod", len) == 0)) { + old = ki2Ptr->eventCaptureMethod.value; + ki2Ptr->eventCaptureMethod.specified = !None; + ki2Ptr->eventCaptureMethod.value = new; + ki2Ptr->num++; + } else if ((c == 'f') && (strncmp(name, "focusWindow", len) == 0) + && (len > 2)) { + ki2Ptr->focusWindow.specified = !None; + old = ki2Ptr->focusWindow.value; + ki2Ptr->focusWindow.value = new; + ki2Ptr->num++; + } else if ((c == 'f') && (strncmp(name, "fonts", len) == 0) + && (len > 2)) { + ki2Ptr->fonts.specified = !None; + old = ki2Ptr->fonts.value; + ki2Ptr->fonts.value = new; + ki2Ptr->num++; + } else if ((c == 'f') && (strncmp(name, "foreground", len) == 0) + && (len > 2)) { + ki2Ptr->foreground.specified = !None; + old = ki2Ptr->foreground.value; + ki2Ptr->foreground.value = new; + ki2Ptr->num++; + } else if ((c == 'i') && (strncmp(name, "inputStyle", len) == 0)) { + ki2Ptr->inputStyle.specified = !None; + old = ki2Ptr->inputStyle.value; + ki2Ptr->inputStyle.value = new; + ki2Ptr->num++; + } else if ((c == 'l') && (strncmp(name, "lineSpacing", len) == 0)) { + ki2Ptr->lineSpacing.specified = !None; + old = ki2Ptr->lineSpacing.value; + ki2Ptr->lineSpacing.value = new; + ki2Ptr->num++; + } else if ((c == 's') && (strncmp(name, "spot", len) == 0) + && (len > 1)) { + ki2Ptr->spot.specified = !None; + old = ki2Ptr->spot.value; + ki2Ptr->spot.value = new; + ki2Ptr->num++; + } else if ((c == 's') && (strncmp(name, "statusArea", len) == 0) + && (len > 1)) { + ki2Ptr->statusArea.specified = !None; + old = ki2Ptr->statusArea.value; + ki2Ptr->statusArea.value = new; + ki2Ptr->num++; + } else if ((c == 'v') && (strncmp(name, "variable", len) == 0)) { + old = ki2Ptr->variable; + ki2Ptr->variable = new; + } else { + Tcl_AppendResult(interp, "Warning: unknown attribute name \"", + *argv, "\".\n", (char *) NULL); + result = TCL_ERROR; + argv++; + argc--; + continue; + } + if (old) ckfree(old); + argv += 2; + argc -= 2; + } + } + if (argc == 1) { + Tcl_AppendResult(interp, "Warning: no attribute value for \"", + *argv, "\".\n", (char *) NULL); + result = TCL_ERROR; + } + + return result; + } + + /* + *-------------------------------------------------------------- + * + * formatAttributeInfo -- + * + * Create a valid Tcl list holding the attribute informattion + * for a sigle attribute option. + * + * Results: + * A Tcl list, dynamically allocated. The caller is expected to + * arrange for this list to be freed eventually. + * + * Side effects: + * Memory is allocated. + * + *-------------------------------------------------------------- + */ + + static char * + formatAttributeInfo(ki2Ptr, name) + Kinput2Info *ki2Ptr; + char *name; + { + char c; + int len; + char *argv[2]; + + if (*name != '-') return NULL; + + name++; + c = name[0]; + len = strlen(name); + if ((c == 'b') && (strncmp(name, "background", len) == 0)) { + argv[0] = "-background"; + argv[1] = (ki2Ptr->background.specified) ? ki2Ptr->background.value : ""; + } else if ((c == 'c') && (strncmp(name, "clientArea", len) == 0) && (len > 1)) { + argv[0] = "-clientArea"; + argv[1] = (ki2Ptr->clientArea.specified) ? ki2Ptr->clientArea.value : ""; + } else if ((c == 'c') && (strncmp(name, "cursor", len) == 0) && (len > 1)) { + argv[0] = "-cursor"; + argv[1] = (ki2Ptr->cursor.specified) ? ki2Ptr->cursor.value : ""; + } else if ((c == 'e') && (strncmp(name, "eventCaptureMethod", len) == 0)) { + argv[0] = "-eventCaptureMethod"; + argv[1] = (ki2Ptr->eventCaptureMethod.specified) ? ki2Ptr->eventCaptureMethod.value : ""; + } else if ((c == 'f') && (strncmp(name, "focusWindow", len) == 0) && (len > 2)) { + argv[0] = "-focusWindow"; + argv[1] = (ki2Ptr->focusWindow.specified) ? ki2Ptr->focusWindow.value : ""; + } else if ((c == 'f') && (strncmp(name, "fonts", len) == 0) && (len > 2)) { + argv[0] = "-fonts"; + argv[1] = (ki2Ptr->fonts.specified) ? ki2Ptr->fonts.value : ""; + } else if ((c == 'f') && (strncmp(name, "foreground", len) == 0) && (len > 2)) { + argv[0] = "-foreground"; + argv[1] = (ki2Ptr->foreground.specified) ? ki2Ptr->foreground.value : ""; + } else if ((c == 'i') && (strncmp(name, "inputStyle", len) == 0)) { + argv[0] = "-inputStyle"; + argv[1] = (ki2Ptr->inputStyle.specified) ? ki2Ptr->inputStyle.value : ""; + } else if ((c == 'l') && (strncmp(name, "lineSpacing", len) == 0)) { + argv[0] = "-lineSpacing"; + argv[1] = (ki2Ptr->lineSpacing.specified) ? ki2Ptr->lineSpacing.value : ""; + } else if ((c == 's') && (strncmp(name, "spot", len) == 0) && (len > 1)) { + argv[0] = "-spot"; + argv[1] = (ki2Ptr->spot.specified) ? ki2Ptr->spot.value : ""; + } else if ((c == 's') && (strncmp(name, "statusArea", len) == 0) && (len > 1)) { + argv[0] = "-statusArea"; + argv[1] = (ki2Ptr->statusArea.specified) ? ki2Ptr->statusArea.value : ""; + } else if ((c == 'v') && (strncmp(name, "variable", len) == 0)) { + argv[0] = "-variable"; + argv[1] = (ki2Ptr->variable) ? ki2Ptr->variable : ""; + } else { + return NULL; + } + return Tcl_Merge(2, argv); + } + + + static int + checkProtocols(dpy, window, cap) + Display *dpy; + Window window; + ConversionAtoms *cap; + { + Atom type; + int format; + unsigned long nitems; + unsigned long bytesafter; + unsigned long *data, *saveddata; + int err; + int ret; + + data = NULL; + err = XGetWindowProperty(dpy, window, cap->profileAtom, + 0L, 100L, False, + cap->typeAtom, + &type, &format, &nitems, + &bytesafter, (unsigned char **)&data); + if (err) return False; + if (format != 32 || type != cap->typeAtom) { + if (data != NULL) free((char *)data); + return False; + } + + ret = False; + saveddata = data; + while (nitems > 0) { + int code = CODE_OF_ATTR(*data); + int len = LENGTH_OF_ATTR(*data); + + data++; + nitems--; + if (nitems < len) break; + + switch (code) { + case CONVPROF_PROTOCOL_VERSION: + if (*data == cap->versionAtom) ret = True; + break; + case CONVPROF_SUPPORTED_STYLES: + break; /* XXX for now */ + default: + break; + } + data += len; + nitems -= len; + } + free((char *)saveddata); + + return ret; + } + + + /* + *-------------------------------------------------------------- + * + * finishConversion -- + * + * This procedure stops the current input conversion + * associated with the specified conversion context. + * + * Results: + * None. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + + static void + finishConversion(tkwin, context) + Tk_Window tkwin; + ConversionContext *context; + { + Tk_DeleteGenericHandler(recvConvAck, (ClientData)tkwin); + Tk_DeleteGenericHandler(getConv, (ClientData)tkwin); + Tk_DeleteEventHandler(tkwin, KeyPressMask|KeyReleaseMask, + forwardKeyEvent, (ClientData)context); + XDeleteContext(Tk_Display(tkwin), Tk_WindowId(tkwin), convertPrivContext); + } + + /* ARGSUSED */ + static int + recvConvAck(clientData, eventPtr) + ClientData clientData; + XEvent *eventPtr; + { + Tk_Window tkwin = (Tk_Window) clientData; + XClientMessageEvent *cev = &(eventPtr->xclient); + ConversionAtoms *cap; + ConversionContext *context; + + if (eventPtr->type != ClientMessage) return 0; + + cap = getAtoms(tkwin); + context = getConversionContext(tkwin); + + /* 正しいイベントかどうかチェックする */ + if (cev->window != Tk_WindowId(tkwin) || + cev->message_type != cap->notifyAtom || + cev->data.l[0] != context->convatom) { + return 0; + } + + /* + * このハンドラはもう用済みなので外す + */ + Tk_DeleteGenericHandler((Tk_GenericProc *)recvConvAck, (ClientData)tkwin); + + if (cev->data.l[2] == None) { + Tcl_AppendResult(context->interp, "Warning: selection request failed", + (char *) NULL); + callFail(tkwin, context); + finishConversion(tkwin, context); + ckfree((char *)context); + return 1; + } + + context->forwardwin = (Window)cev->data.l[3]; + callStart(tkwin, context); + + /* + * PropertyNotify と CONVERSION_END 用のイベントハンドラを + * 登録する + */ + Tk_CreateGenericHandler((Tk_GenericProc *)getConv, (ClientData)tkwin); + + /* + * キーイベントを入力サーバに送るためのイベントハンドラを登録する + */ + Tk_CreateEventHandler(tkwin, KeyPressMask|KeyReleaseMask, + forwardKeyEvent, (ClientData)context); + + /* プロパティ名をストアする */ + context->property = cev->data.l[2]; + return 1; + } + + + /* ARGSUSED */ + static int + getConv(clientData, eventPtr) + ClientData clientData; + XEvent *eventPtr; + { + Tk_Window tkwin = (Tk_Window) clientData; + ConversionAtoms *cap; + ConversionContext *context; + + /* PropertyNotify, ClientMessage, DestroyNotify 以外は無視する */ + if (eventPtr->type != PropertyNotify && eventPtr->type != ClientMessage + && eventPtr->type != DestroyNotify) + return 0; + + /* ウィンドウ ID のチェック */ + if (eventPtr->xany.window != Tk_WindowId(tkwin)) return 0; + + cap = getAtoms(tkwin); + context = getConversionContext(tkwin); + + if (eventPtr->type == ClientMessage) { + XClientMessageEvent *cev = &(eventPtr->xclient); + + /* + * 本当に入力終了のイベントかどうかチェックする + */ + if (cev->message_type == cap->endAtom && + cev->format == 32 && + cev->data.l[0] == context->convatom) { + callEnd(tkwin, context); + finishConversion(tkwin, context); + ckfree((char *)context); + return 1; + } + } else if (eventPtr->type == DestroyNotify) { + XDestroyWindowEvent *dev = &(eventPtr->xdestroywindow); + + if (dev->window == Tk_WindowId(tkwin)) { + callEnd(tkwin, context); + finishConversion(tkwin, context); + ckfree((char *)context); + return 0; + } + } else { /* PropertyNotify */ + XPropertyEvent *pev = &(eventPtr->xproperty); + Atom proptype; + int propformat; + unsigned long propsize, rest; + unsigned char *propvalue; + + if (context->property == None) return 0; + + /* 正しいイベントかどうかのチェック */ + if (pev->window != Tk_WindowId(tkwin) || + pev->atom != context->property || + pev->state != PropertyNewValue) { + return 0; + } + + /* もしコールバック関数 context->inputproc が + * NULL ならばプロパティを削除するだけ + */ + if (context->inputproc == NULL) { + XDeleteProperty(Tk_Display(tkwin), Tk_WindowId(tkwin), context->property); + return 1; + } + + /* プロパティから変換文字列を取り出す */ + XGetWindowProperty(Tk_Display(tkwin), Tk_WindowId(tkwin), + context->property, + 0L, 100000L, True, AnyPropertyType, + &proptype, &propformat, &propsize, &rest, + &propvalue); + + /* プロパティのタイプ・フォーマットのチェック */ + if (proptype == None) { + /* プロパティが存在しなかった + * これは連続して何回もプロパティにデータが + * 入れられた時、一回の GetWindowProperty で + * 複数のデータをとってしまったあとに起きる + * 従ってこれはエラーではない + */ + return 1; + } + + /* コールバックを呼ぶ */ + (*context->inputproc)(context->interp, tkwin, context->convatom, + proptype, propformat, + propsize, propvalue, + context->clientData); + + if (propvalue != NULL) XFree((char *)propvalue); + + return 1; + } + return 0; + } + + + static void + callStart(tkwin, context) + Tk_Window tkwin; + ConversionContext *context; + { + if (context->startendproc != NULL) { + (*context->startendproc)(context->interp, tkwin, context->convatom, + 0, context->clientData); + } + } + + + static void + callFail(tkwin, context) + Tk_Window tkwin; + ConversionContext *context; + { + if (context->startendproc != NULL) { + (*context->startendproc)(context->interp, tkwin, context->convatom, + -1, context->clientData); + } + } + + + static void + callEnd(tkwin, context) + Tk_Window tkwin; + ConversionContext *context; + { + if (context->startendproc != NULL) { + (*context->startendproc)(context->interp, tkwin, context->convatom, + 1, context->clientData); + } + } + + + static ConversionAtoms * + getAtoms(tkwin) + Tk_Window tkwin; + { + int i; + Display *disp = Tk_Display(tkwin); + ConversionAtoms *cap; + static ConversionAtoms *convatomp; + static int ndisp = 0; + #define nalloc 2 + + /* + * アトムはディスプレイごとに違うので、 + * ディスプレイごとに作らなくてはならない + */ + + /* すでにアトムが作られているかどうか調べる */ + cap = convatomp; + for (i = 0; i < ndisp; i++, cap++) { + if (cap->display == disp) return cap; + } + + /* + * まだ作られていないので新しく作る + */ + if (ndisp == 0) { + /* 最初なので Context も同時に作る */ + convertPrivContext = XUniqueContext(); + convatomp = (ConversionAtoms *) + malloc(sizeof(ConversionAtoms) * nalloc); + cap = convatomp; + } else if (ndisp % nalloc == 0) { + /* サイズを増やす */ + convatomp = (ConversionAtoms *) + realloc((char *)convatomp, + sizeof(ConversionAtoms) * (ndisp + nalloc)); + cap = convatomp + ndisp; + } else { + cap = convatomp + ndisp; + } + + /* ディスプレイの登録 */ + cap->display = disp; + + /* Atom の作成 */ + cap->profileAtom = Tk_InternAtom(tkwin, CONVERSION_PROFILE); + cap->typeAtom = Tk_InternAtom(tkwin, CONVERSION_ATTRIBUTE_TYPE); + cap->versionAtom = Tk_InternAtom(tkwin, PROTOCOL_VERSION); + cap->reqAtom = Tk_InternAtom(tkwin, "CONVERSION_REQUEST"); + cap->notifyAtom = Tk_InternAtom(tkwin, "CONVERSION_NOTIFY"); + cap->endAtom = Tk_InternAtom(tkwin, "CONVERSION_END"); + cap->endReqAtom = Tk_InternAtom(tkwin, "CONVERSION_END_REQUEST"); + cap->attrAtom = Tk_InternAtom(tkwin, "CONVERSION_ATTRIBUTE"); + cap->attrNotifyAtom = Tk_InternAtom(tkwin, "CONVERSION_ATTRIBUTE_NOTIFY"); + + ndisp++; + + return cap; + } + + + static ConversionContext * + getConversionContext(tkwin) + Tk_Window tkwin; + { + ConversionContext *context; + + if (XFindContext(Tk_Display(tkwin), Tk_WindowId(tkwin), + convertPrivContext, (caddr_t *)&context)) { + /* error -- 多分コンテキストが見つからなかったため */ + return NULL; + } else { + return context; + } + } + + + static long + getInputStyle(s) + char *s; + { + char c; + int len; + + c = s[0]; + len = strlen(s); + + if ((c == 'o') && (strncmp(s, "off", len) == 0) && (len > 2)) { + return CONVARG_OFFTHESPOT; + } else if ((c == 'o') && (strncmp(s, "over", len) == 0) && (len > 2)) { + return CONVARG_OVERTHESPOT; + } else if ((c == 'r') && (strncmp(s, "root", len) == 0)) { + return CONVARG_ROOTWINDOW; + } + return 0L; + } + + + static long + getCaptureMethod(s) + char *s; + { + char c; + int len; + + c = s[0]; + len = strlen(s); + + + if ((c == 'n') && (strncmp(s, "none", len) == 0)) { + return CONVARG_NONE; + } else if ((c == 'i') && (strncmp(s, "inputOnly", len) == 0)) { + return CONVARG_CREATE_INPUTONLY; + } else if ((c == 'f') && (strncmp(s, "focusSelect", len) == 0)) { + return CONVARG_SELECT_FOCUS_WINDOW; + } + return 0L; + } + + + static int + makeAttrData(interp, tkwin, ki2Ptr, datap) + Tcl_Interp *interp; + Tk_Window tkwin; + Kinput2Info *ki2Ptr; + unsigned long **datap; + { + static int max_length = 0; + static unsigned long *buf = NULL; + int length = 0; + + #define ALLOC(n) \ + if (length + (n) > max_length ) { \ + unsigned long *tmp; \ + max_length += (n); \ + tmp = (unsigned long *) ckalloc((unsigned)(max_length * 4)); \ + memcpy((VOID *) tmp, (VOID *) buf, length * 4); \ + ckfree((char *) buf); \ + buf = tmp; \ + } + + if (buf == NULL) { + buf = (unsigned long *) ckalloc((unsigned)(max_length * 4)); + } + + if (ki2Ptr->inputStyle.specified) { + long style = getInputStyle(ki2Ptr->inputStyle.value); + + if (style == 0L) { + Tcl_AppendResult(interp, "Warning: bad inputStyle - \"", + ki2Ptr->inputStyle.value, "\"\n", (char *) NULL); + ki2Ptr->inputStyle.specified = None; + } else { + ALLOC(2); + buf[length] = CONV_ATTR(CONVATTR_INPUT_STYLE, 1); + buf[length+1] = style; + length += 2; + } + } + if (ki2Ptr->focusWindow.specified) { + Tk_Window win = Tk_NameToWindow(interp, ki2Ptr->focusWindow.value, tkwin); + + if (win == NULL ) { + Tcl_AppendResult(interp, "Warning: bad focusWindow - \"", + ki2Ptr->focusWindow.value, "\"\n", (char *) NULL); + ki2Ptr->focusWindow.specified = None; + } else { + ALLOC(2); + buf[length] = CONV_ATTR(CONVATTR_FOCUS_WINDOW, 1); + buf[length+1] = (unsigned long) Tk_WindowId(win); + length += 2; + } + } + if (ki2Ptr->spot.specified) { + int xargc; + char **xargv; + int spotX, spotY; + + if (Tcl_SplitList(interp, ki2Ptr->spot.value, &xargc, &xargv) != TCL_OK) { + ki2Ptr->spot.specified = None; + } else { + if (xargc != 2 + || Tcl_GetInt(interp, xargv[0], &spotX) != TCL_OK + || Tcl_GetInt(interp, xargv[1], &spotY) != TCL_OK) { + Tcl_AppendResult(interp, "Warning: bad spot - \"", + ki2Ptr->spot.value, "\"\n", (char *) NULL); + ki2Ptr->spot.specified = None; + } else { + ALLOC(2); + buf[length] = CONV_ATTR(CONVATTR_SPOT_LOCATION, 1); + buf[length+1] = (spotX << 16) | (spotY & 0xffff); + length += 2; + } + ckfree((char *) xargv); + } + } + if (ki2Ptr->foreground.specified && ki2Ptr->background.specified) { + XColor *fgPtr, *bgPtr; + + fgPtr = Tk_GetColor(interp, tkwin, Tk_GetUid(ki2Ptr->foreground.value)); + bgPtr = Tk_GetColor(interp, tkwin, Tk_GetUid(ki2Ptr->background.value)); + if (fgPtr == NULL) { + Tcl_AppendResult(interp, "Warning: bad foreground - \"", + ki2Ptr->foreground.value, "\"\n", (char *) NULL); + ki2Ptr->foreground.specified = None; + } + if (bgPtr == NULL) { + Tcl_AppendResult(interp, "Warning: bad background - \"", + ki2Ptr->background.value, "\"\n", (char *) NULL); + ki2Ptr->background.specified = None; + } + if (fgPtr && bgPtr) { + ALLOC(3); + buf[length] = CONV_ATTR(CONVATTR_COLOR, 2); + buf[length+1] = fgPtr->pixel; + buf[length+2] = bgPtr->pixel; + length += 3; + } + } + if (ki2Ptr->eventCaptureMethod.specified) { + long method = getCaptureMethod(ki2Ptr->eventCaptureMethod.value); + + if (method == 0L) { + Tcl_AppendResult(interp, "Warning: bad eventCaptureMethod - \"", + ki2Ptr->eventCaptureMethod.value, "\"\n", (char *) NULL); + ki2Ptr->eventCaptureMethod.specified = None; + } else { + ALLOC(2); + buf[length] = CONV_ATTR(CONVATTR_EVENT_CAPTURE_METHOD, 1); + buf[length+1] = method; + length += 2; + } + } + if (ki2Ptr->lineSpacing.specified) { + int spacing; + + if (Tcl_GetInt(interp, ki2Ptr->lineSpacing.value, &spacing) != TCL_OK) { + Tcl_AppendResult(interp, "Warning: bad lineSpacing - \"", + ki2Ptr->lineSpacing.value, "\"\n", (char *) NULL); + ki2Ptr->lineSpacing.specified = None; + } else { + ALLOC(2); + buf[length] = CONV_ATTR(CONVATTR_LINE_SPACING, 1); + buf[length+1] = spacing; + length += 2; + } + } + if (ki2Ptr->clientArea.specified) { + int xargc; + char **xargv; + int x, y, width, height; + + if (Tcl_SplitList(interp, ki2Ptr->clientArea.value, &xargc, &xargv) != TCL_OK) { + ki2Ptr->clientArea.specified = None; + } else { + if (xargc != 4 + || Tcl_GetInt(interp, xargv[0], &x) != TCL_OK + || Tcl_GetInt(interp, xargv[1], &y) != TCL_OK + || Tcl_GetInt(interp, xargv[2], &width) != TCL_OK + || Tcl_GetInt(interp, xargv[3], &height) != TCL_OK) { + Tcl_AppendResult(interp, "Warning: bad clientArea - \"", + ki2Ptr->clientArea.value, "\"\n", (char *) NULL); + ki2Ptr->clientArea.specified = None; + } else { + ALLOC(3); + buf[length] = CONV_ATTR(CONVATTR_CLIENT_AREA, 2); + buf[length+1] = (x << 16) | (y & 0xffff); + buf[length+2] = (width << 16) | (height & 0xffff); + length += 3; + } + ckfree((char *) xargv); + } + } + if (ki2Ptr->statusArea.specified) { + int xargc; + char **xargv; + int x, y, width, height; + + if (Tcl_SplitList(interp, ki2Ptr->statusArea.value, &xargc, &xargv) == TCL_OK) { + ki2Ptr->statusArea.specified = None; + } else { + if (xargc != 4 + || Tcl_GetInt(interp, xargv[0], &x) != TCL_OK + || Tcl_GetInt(interp, xargv[1], &y) != TCL_OK + || Tcl_GetInt(interp, xargv[2], &width) != TCL_OK + || Tcl_GetInt(interp, xargv[3], &height) != TCL_OK) { + Tcl_AppendResult(interp, "Warning: bad statusArea - \"", + ki2Ptr->statusArea.value, "\"\n", (char *) NULL); + ki2Ptr->statusArea.specified = None; + } else { + ALLOC(3); + buf[length] = CONV_ATTR(CONVATTR_STATUS_AREA, 2); + buf[length+1] = (x << 16) | (y & 0xffff); + buf[length+2] = (width << 16) | (height & 0xffff); + length += 3; + } + ckfree((char *) xargv); + } + } + if (ki2Ptr->cursor.specified) { + Cursor cursor = (Cursor) Tk_GetCursor(interp, tkwin, + Tk_GetUid(ki2Ptr->cursor.value)); + + if (cursor == None) { + Tcl_AppendResult(interp, "Warning: bad cursor - \"", + ki2Ptr->cursor.value, "\"\n", (char *) NULL); + ki2Ptr->cursor.specified = None; + } else { + ALLOC(2); + buf[length] = CONV_ATTR(CONVATTR_CURSOR, 1); + buf[length+1] = cursor; + length += 2; + } + } + if (ki2Ptr->fonts.specified) { + int xargc; + char **xargv; + + if (Tcl_SplitList(interp, ki2Ptr->fonts.value, &xargc, &xargv) == TCL_OK) { + XFontStruct *fontPtr; + int nfonts, i; + unsigned long atom; + + ALLOC(xargc+1); + nfonts = 0; + for (i = 0; i < xargc; i++) { + fontPtr = Tk_GetFontStruct(interp, tkwin, Tk_GetUid(xargv[i])); + if (fontPtr != NULL + && XGetFontProperty(fontPtr, XA_FONT, &atom)) { + buf[length + ++nfonts] = atom; + } else { + Tcl_AppendResult(interp, "Warning: bad font - \"", + xargv[i], "\"\n", (char *) NULL); + } + } + if (nfonts == 0) { + ki2Ptr->fonts.specified = None; + } else { + buf[length] = CONV_ATTR(CONVATTR_FONT_ATOMS, nfonts); + length += nfonts+1; + } + + ckfree((char *) xargv); + } + } + + *datap = (unsigned long *) ckalloc((unsigned)(length * 4)); + memcpy((VOID *) *datap, (VOID *) buf, length * 4); + + return length; + #undef ALLOC + } + + /* + *-------------------------------------------------------------- + * + * forwardKeyEvent -- + * + * This procedure forwards the key events to the input server + * (kinput2). + * + * Results: + * None. + * + * Side effects: + * This procedure may change the contents of the event. + * + *-------------------------------------------------------------- + */ + + static void + forwardKeyEvent(clientdata, event) + ClientData clientdata; + XEvent *event; + { + ConversionContext *context = (ConversionContext *)clientdata; + Display *dpy = event->xany.display; + Window w = context->forwardwin; + Tk_ErrorHandler handle; + + /* + * If the event is a non-synthetic Key event and the target + * window of the input server is not None, we forward the event + * to the window. + * Checking whether the event is synthetic or not is necessary + * because the input server might send back the event we've just + * forwarded, and forwarding those events sent back by the server + * can cause an infinite event loop. + */ + if (w != None && !event->xany.send_event && + (event->type == KeyPress || event->type == KeyRelease)) { + Window orig_win = event->xkey.window; + + event->xkey.window = w; + handle = Tk_CreateErrorHandler(dpy, -1, -1, -1, + (Tk_ErrorProc *)stopForwarding, + clientdata); + (void)XSendEvent(dpy, w, False, KeyPressMask, event); + Tk_DeleteErrorHandler(handle); + event->xkey.window = orig_win; + + /* + * Since this event has been sent to the input server, + * we must stop the further processing of the event. + * We have determined to change the keycode field of + * the event to an invalid value, because there's no + * appropriate way to do it. + * The range of the valid keycode is 8-255, and keycode 0 + * is used by the X11R5 I18N as a special code, so we've + * chosen 1. + */ + event->xkey.keycode = 1; + } + } + + /* + *-------------------------------------------------------------- + * + * stopForwarding -- + * + * This procedure stops forwarding the key events. + * It is intended to use as an error handler which is + * installed by Tk_CreateErrorHandler(). + * + * Results: + * None. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + + static int + stopForwarding(clientdata, errEvent) + ClientData clientdata; + XErrorEvent *errEvent; + { + ConversionContext *context = (ConversionContext *)clientdata; + + if (errEvent->type == BadWindow) { + callEnd(context->tkwin, context); + finishConversion(context->tkwin, context); + ckfree((char *)context); + } + return 0; + } + + #endif /* KANJI && KINPUT2 */ diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/unix/tkKinput2.h ./unix/tkKinput2.h *** ../tk4.2/unix/tkKinput2.h Thu Jan 1 09:00:00 1970 --- ./unix/tkKinput2.h Fri Oct 18 13:15:23 1996 *************** *** 0 **** --- 1,323 ---- + /* + * tkKinput2.h -- + * + * Declarations for the kinput2. + * + * Copyright 1988,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/tk/unix/tkKinput2.h,v 1.1 1995/12/21 08:32:41 hoshi Exp $ + */ + + #ifndef _TKKINPUT2 + #define _TKKINPUT2 + + /* 変換サーバのプロファイルが入るプロパティ名 */ + #define CONVERSION_PROFILE "_CONVERSION_PROFILE" + + /* 変換サーバのプロファイルのプロパティと変換属性のプロパティのタイプ */ + #define CONVERSION_ATTRIBUTE_TYPE "_CONVERSION_ATTRIBUTE_TYPE" + + /* プロトコルバージョン名 */ + #define PROTOCOL_VERSION "PROTOCOL-2.0" + + #define CONV_ATTR(code,len) ((unsigned long)((code)<<16)+(len)) + + #define UPPER16U(data) (((data)>>16)&0xffff) + #define UPPER16S(data) ((short)(((data)>>16)&0xffff)) + #define LOWER16U(data) ((data)&0xffff) + #define LOWER16S(data) ((short)((data)&0xffff)) + + #define CODE_OF_ATTR(head) UPPER16U(head) + #define LENGTH_OF_ATTR(head) LOWER16U(head) + + /* + * Conversion Profile Codes + */ + + #define CONVPROF_PROTOCOL_VERSION 1 + #define CONVPROF_SUPPORTED_STYLES 2 + #define CONVPROF_SUPPORTED_EXTENSIONS 3 + #define CONVPROF_EXTENSION_DATA 4 + + /* + * Standard Conversion Attribute Codes (0-255) + */ + + /* 0-127: can be specified at any time (startup and during conversion) */ + #define CONVATTR_NONE 0 + #define CONVATTR_INDIRECT 1 + #define CONVATTR_FOCUS_WINDOW 2 + #define CONVATTR_SPOT_LOCATION 3 + #define CONVATTR_CLIENT_AREA 4 + #define CONVATTR_STATUS_AREA 5 + #define CONVATTR_COLORMAP 6 + #define CONVATTR_COLOR 7 + #define CONVATTR_BACKGROUND_PIXMAP 8 + #define CONVATTR_LINE_SPACING 9 + #define CONVATTR_FONT_ATOMS 10 + #define CONVATTR_CURSOR 11 + + /* 128-255: can be specified only at startup time */ + #define CONVATTR_INPUT_STYLE 128 + #define CONVATTR_EVENT_CAPTURE_METHOD 129 + #define CONVATTR_USE_EXTENSION 255 + + /* argument for CONVATTR_INPUT_STYLE and CONVPROP_SUPPORTED_STYLES */ + #define CONVARG_ROOTWINDOW 1L + #define CONVARG_OFFTHESPOT 2L + #define CONVARG_OVERTHESPOT 4L + + /* argument for CONVATTR_EVENT_CAPTURE_METHOD */ + #define CONVARG_NONE 0L + #define CONVARG_CREATE_INPUTONLY 1L + #define CONVARG_SELECT_FOCUS_WINDOW 2L + + /* + * プロファイルデータ / 変換属性データの表現方法 + * + * 変換サーバの特性を表すプロファイルデータと、変換に関する属性を指定す + * る変換属性データは共通のフォーマットを用いる。 + * + * 個々のデータは 32bit値の配列で表現される。最初の 1ワードはヘッダで、 + * それに 0ワード以上のデータが続く。ヘッダの上位 16bit はそのプロファイ + * ル / 変換属性のコードを表し、下位 16 bit は続くデータのワード数 + * (32bit 単位) を表す。 + * + * +----------------+----------------+ + * | Code (16bit) | Length (16bit) | + * +----------------+----------------+ + * | Data0 | + * +---------------------------------+ + * | ..... | + * +---------------------------------+ + * | DataN | + * +---------------------------------+ + * + * 実際のプロファイルデータや変換属性データはこのデータがいくつか連続し + * たものである。 + */ + + /* + * プロファイルデータ + * + * プロファイルデータ用のコードは次の 4種類が定義されている。変換属性 + * データと異なり、プライベート用のコード領域などは用意されていない。 + * + * Protocol Version + * code: 1 + * data-length: 1 + * data[0]: + * CARD32: protocol version atom ("PROTOCOL-2.0") + * + * データは変換サーバのプロトコルバージョンを表すアトムである。ここ + * で定義されているプロトコルのバージョンは "PROTOCOL-2.0" である。 + * + * Supported Styles + * code: 2 + * data-length: 1 + * data[0]: + * CARD32: input styles + * + * データは変換サーバがサポートする入力スタイルを表す。サポートする + * 入力スタイルの値の bitwise-or である。 + * + * Supported Extensions + * code: 3 + * data-length: N + * data[0]: + * CARD32: extension atom 1 (Atom) + * ... + * data[N-1]: + * CARD32: extension atom N (Atom) + * + * データは変換サーバがサポートする拡張を表すアトムのリストである。 + * + * Extension Data + * code: 4 + * data-length: N + * data[0]: + * CARD32: extension atom (Atom) + * data[1] - data[N-1]: + * extension specific data + * + * データは拡張独自に定義したプロファイルデータである。標準プロトコ + * ルとしてはデータの先頭に拡張アトム (これはSupported Extensions + * に指定されたものでなければならない)をつけることを規定するだけで、 + * その後のデータに関しては一切規定しない。 + * + * クライアント側の無用の混乱を防ぐため、Protocol Version と Supported + * Stylesの項目は必ずなければならない。また、Extension Data 以外はプロファ + * イルデータの中に同じコードのデータが複数あってはならない。 + */ + + /* + * 変換属性データ + * + * 属性コードのうち、0 から 255 までは標準プロトコルが使用するもので、現 + * 在属性が割り振られていないからといって勝手に使用してはならない。その + * ような目的のため属性コード 256 から 65535 がプライベートコード拡張領 + * 域として用意されている。ただしこの領域の使用に当たってはあらかじめそ + * の拡張コードを使用することを Use Extension (下記参照) を用いてあらか + * じめ宣言する必要がある。 + * + * 属性データの指定方法には、変換開始時に指定する方法と、変換中に指定す + * る方法の 2通りがあるが、属性コードによっては変換開始時にしか指定でき + * ないものがある。そこで、0-255 の標準コードのうち、0 から 127 までは変 + * 換開始時でも変換中でも指定できるもの、128 から 255 までは変換開始時に + * しか指定できないもの、に分けてある。拡張コードについては特にこのよう + * な区別は定めない。 + * + * このプロトコルで定義される属性コードは次の通りである。 + * + * -- 変換開始時にも、変換途中にも指定できるもの -- + * + * No Operation: + * code: 0 + * data-length: N (could be 0) + * data: anything + * + * 何もしない。プロパティのある部分をスキップさせるのに便利。 + * + * Indirect Attribute: + * code: 1 + * data-length: 1 + * data[0]: + * CARD32: property name (Atom) + * + * 指定されたプロパティに従って属性を設定する。CONVERSION_ATTRIBUTE + * イベントで複数の属性データを設定したい時や、イベントに属性データが + * 入り切らない時に使用する。 + * + * Focus Window: + * code: 2 + * data-length: 1 + * data[0]: + * CARD32: focus window (Window) + * + * フォーカスウィンドウを指定する。 + * + * Spot Location: + * data-length: 1 + * data[0]: + * INT16(upper 16bit): X + * INT16(lower 16bit): Y + * + * スポットロケーションを指定する。ベースラインの開始点で指定する。 + * + * Client Area: + * data-length: 2 + * data[0]: + * INT16(upper 16bit): X + * INT16(lower 16bit): Y + * data[1]: + * CARD16(upper 16bit): Width + * CARD16(lower 16bit): Height + * + * 変換テキスト表示領域を指定する。 + * + * Status Area: + * data-length: 2 + * data[0]: + * INT16(upper 16bit): X + * INT16(lower 16bit): Y + * data[1]: + * CARD16(upper 16bit): Width + * CARD16(lower 16bit): Height + * + * ステータス表示領域を指定する。 + * + * Colormap: + * data-length: 1 + * data[0]: + * CARD32: colormap (XID) + * + * カラーマップ ID を指定する。 + * + * Color: + * data-length: 2 + * data[0]: + * CARD32: foreground pixel + * data[1]: + * CARD32: background pixel + * + * フォアグラウンドとバックグラウンドのピクセル値を指定する。 + * + * Background Pixmap: + * data-length: 1 + * data[0]: + * CARD32: background pixmap (Pixmap) + * + * バックグラウンドの Pixmap ID を指定する。 + * + * Line Spacing: + * data-length: 1 + * data[0]: + * CARD32: line spacing + * + * 行間を指定する。ベースライン間の距離で指定する。 + * + * Font Atoms: + * data-length: N (>0) + * data[0]: + * CARD32: font atom 1 (Atom) + * ... + * data[N-1]: + * CARD32: font atom N (Atom) + * + * 使用するフォントの "FONT" アトムのリストを指定する。 + * + * Cursor: + * data-length: 1 + * data[0]: + * CARD32: cursor (Cursor) + * + * カーソル ID を指定する。 + * + * -- 変換開始時のみ指定できるもの -- + * + * Input Style: + * data-length: 1 + * data[0]: + * CARD32: input style + * + * 入力方法を指定する。 + * デフォルトは Root Window Style である。 + * + * Event Capture Method: + * data-length: 1 + * data[0]: + * CARD32: event capture method + * + * クライアントウィンドウからのイベントの取得方法を指定する。デフォ + * ルトはクライアントウィンドウの前に InputOnly ウィンドウを作って + * そのキーイベントをセレクトするというものである。他の方法としては、 + * フォーカスウィンドウ (フォーカスウィンドウが指定されていなければ + * クライアントウィンドウ) のキーイベントを直接セレクトする (この場 + * 合、変換中はクライアントはキーイベントを無視しなくてはならない) + * ものと、何もしない、つまり変換中のクライアントはキーイベントをフ + * ロントエンドに SendEvent しなくてはならない、という方法がある。 + * + * Use Extension: + * data-length: N + * data[0]: + * CARD32: extension atom 1 (Atom) + * ... + * data[N-1]: + * CARD32: extension atom N (Atom) + * + * この属性設定で使用される拡張を指定する。ここで指定する拡張はサー + * バがサポートしているもの、つまりプロファイルデータ中のSupported + * Extensions に書かれた拡張でなければならない。 + */ + + #endif /* _TKKINPUT2 */ diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/unix/tkUnixDefault.h ./unix/tkUnixDefault.h *** ../tk4.2/unix/tkUnixDefault.h Tue Aug 27 02:09:46 1996 --- ./unix/tkUnixDefault.h Fri Oct 18 13:15:23 1996 *************** *** 54,60 **** --- 54,65 ---- #define DEF_BUTTON_DISABLED_FG_COLOR DISABLED #define DEF_BUTTON_DISABLED_FG_MONO "" #define DEF_BUTTON_FG BLACK + #ifdef KANJI + #define DEF_BUTTON_FONT "a14" + #define DEF_BUTTON_KANJIFONT "k14" + #else #define DEF_BUTTON_FONT "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*" + #endif /* KANJI */ #define DEF_BUTTON_HEIGHT "0" #define DEF_BUTTON_HIGHLIGHT_BG NORMAL_BG #define DEF_BUTTON_HIGHLIGHT BLACK *************** *** 115,120 **** --- 120,128 ---- #define DEF_CANVAS_SELECT_FG_COLOR BLACK #define DEF_CANVAS_SELECT_FG_MONO WHITE #define DEF_CANVAS_TAKE_FOCUS (char *) NULL + #ifdef KANJI + #define DEF_CANVAS_PS_KANJI_FONT "Ryumin-Light-H" + #endif /* KANJI */ #define DEF_CANVAS_WIDTH "10c" #define DEF_CANVAS_X_SCROLL_CMD "" #define DEF_CANVAS_X_SCROLL_INCREMENT "0" *************** *** 130,136 **** --- 138,149 ---- #define DEF_ENTRY_BORDER_WIDTH "2" #define DEF_ENTRY_CURSOR "xterm" #define DEF_ENTRY_EXPORT_SELECTION "1" + #ifdef KANJI + #define DEF_ENTRY_FONT "a14" + #define DEF_ENTRY_KANJIFONT "k14" + #else #define DEF_ENTRY_FONT "-Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*" + #endif /* KANJI */ #define DEF_ENTRY_FG BLACK #define DEF_ENTRY_HIGHLIGHT_BG NORMAL_BG #define DEF_ENTRY_HIGHLIGHT BLACK *************** *** 184,190 **** --- 197,208 ---- #define DEF_LISTBOX_BORDER_WIDTH "2" #define DEF_LISTBOX_CURSOR "" #define DEF_LISTBOX_EXPORT_SELECTION "1" + #ifdef KANJI + #define DEF_LISTBOX_FONT "a14" + #define DEF_LISTBOX_KANJIFONT "k14" + #else #define DEF_LISTBOX_FONT "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*" + #endif /* KANJI */ #define DEF_LISTBOX_FG BLACK #define DEF_LISTBOX_HEIGHT "10" #define DEF_LISTBOX_HIGHLIGHT_BG NORMAL_BG *************** *** 214,219 **** --- 232,240 ---- #define DEF_MENU_ENTRY_COMMAND (char *) NULL #define DEF_MENU_ENTRY_FG (char *) NULL #define DEF_MENU_ENTRY_FONT (char *) NULL + #ifdef KANJI + #define DEF_MENU_ENTRY_KANJIFONT (char *) NULL + #endif /* KANJI */ #define DEF_MENU_ENTRY_IMAGE (char *) NULL #define DEF_MENU_ENTRY_INDICATOR "1" #define DEF_MENU_ENTRY_LABEL (char *) NULL *************** *** 243,249 **** --- 264,275 ---- #define DEF_MENU_CURSOR "arrow" #define DEF_MENU_DISABLED_FG_COLOR DISABLED #define DEF_MENU_DISABLED_FG_MONO "" + #ifdef KANJI + #define DEF_MENU_FONT "a14" + #define DEF_MENU_KANJIFONT "k14" + #else #define DEF_MENU_FONT "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*" + #endif /* KANJI */ #define DEF_MENU_FG BLACK #define DEF_MENU_POST_COMMAND "" #define DEF_MENU_RELIEF "raised" *************** *** 270,276 **** --- 296,307 ---- #define DEF_MENUBUTTON_CURSOR "" #define DEF_MENUBUTTON_DISABLED_FG_COLOR DISABLED #define DEF_MENUBUTTON_DISABLED_FG_MONO "" + #ifdef KANJI + #define DEF_MENUBUTTON_FONT "a14" + #define DEF_MENUBUTTON_KANJIFONT "k14" + #else #define DEF_MENUBUTTON_FONT "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*" + #endif /* KANJI */ #define DEF_MENUBUTTON_FG BLACK #define DEF_MENUBUTTON_HEIGHT "0" #define DEF_MENUBUTTON_HIGHLIGHT_BG NORMAL_BG *************** *** 302,308 **** --- 333,344 ---- #define DEF_MESSAGE_BORDER_WIDTH "2" #define DEF_MESSAGE_CURSOR "" #define DEF_MESSAGE_FG BLACK + #ifdef KANJI + #define DEF_MESSAGE_FONT "a14" + #define DEF_MESSAGE_KANJIFONT "k14" + #else #define DEF_MESSAGE_FONT "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*" + #endif #define DEF_MESSAGE_HIGHLIGHT_BG NORMAL_BG #define DEF_MESSAGE_HIGHLIGHT BLACK #define DEF_MESSAGE_HIGHLIGHT_WIDTH "0" *************** *** 328,334 **** --- 364,375 ---- #define DEF_SCALE_COMMAND "" #define DEF_SCALE_CURSOR "" #define DEF_SCALE_DIGITS "0" + #ifdef KANJI + #define DEF_SCALE_FONT "a14" + #define DEF_SCALE_KANJIFONT "k14" + #else #define DEF_SCALE_FONT "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*" + #endif /* KANJI */ #define DEF_SCALE_FG_COLOR BLACK #define DEF_SCALE_FG_MONO BLACK #define DEF_SCALE_FROM "0" *************** *** 390,396 **** --- 431,442 ---- #define DEF_TEXT_CURSOR "xterm" #define DEF_TEXT_FG BLACK #define DEF_TEXT_EXPORT_SELECTION "1" + #ifdef KANJI + #define DEF_TEXT_FONT "a14" + #define DEF_TEXT_KANJIFONT "k14" + #else #define DEF_TEXT_FONT "-*-Courier-Medium-R-Normal--*-120-*-*-*-*-*-*" + #endif #define DEF_TEXT_HEIGHT "24" #define DEF_TEXT_HIGHLIGHT_BG NORMAL_BG #define DEF_TEXT_HIGHLIGHT BLACK diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/unix/tkUnixSelect.c ./unix/tkUnixSelect.c *** ../tk4.2/unix/tkUnixSelect.c Tue Aug 27 02:09:51 1996 --- ./unix/tkUnixSelect.c Fri Oct 18 13:15:23 1996 *************** *** 301,307 **** --- 301,312 ---- } else { incrPtr->offsets[i] += numItems; } + #ifdef KANJI + if (formatType == XA_STRING || + formatType == incrPtr->winPtr->dispPtr->compoundTextAtom) { + #else if (formatType == XA_STRING) { + #endif /* KANJI */ propPtr = (char *) buffer; format = 8; } else { *************** *** 731,737 **** --- 736,747 ---- propPtr = (char *) buffer; format = 32; incr.offsets[i] = 0; + #ifdef KANJI + } else if (type == XA_STRING || + type == winPtr->dispPtr->compoundTextAtom) { + #else } else if (type == XA_STRING) { + #endif /* KANJI */ propPtr = (char *) buffer; format = 8; } else { diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/unix/tkUnixWm.c ./unix/tkUnixWm.c *** ../tk4.2/unix/tkUnixWm.c Tue Aug 27 02:09:48 1996 --- ./unix/tkUnixWm.c Fri Oct 18 13:15:24 1996 *************** *** 461,475 **** --- 461,483 ---- if (wmPtr->titleUid == NULL) { wmPtr->titleUid = winPtr->nameUid; } + #ifdef KANJI + (void) TkSetWMTextProperty(winPtr, XA_WM_NAME, wmPtr->titleUid); + #else if (XStringListToTextProperty(&wmPtr->titleUid, 1, &textProp) != 0) { XSetWMName(winPtr->display, winPtr->window, &textProp); XFree((char *) textProp.value); } + #endif /* KANJI */ TkWmSetClass(winPtr); if (wmPtr->iconName != NULL) { + #ifdef KANJI + (void) TkSetWMTextProperty(winPtr, XA_WM_ICON_NAME, wmPtr->iconName); + #else XSetIconName(winPtr->display, winPtr->window, wmPtr->iconName); + #endif /* KANJI */ } if (wmPtr->master != None) { *************** *** 481,496 **** --- 489,513 ---- UpdateHints(winPtr); UpdateWmProtocols(wmPtr); if (wmPtr->cmdArgv != NULL) { + #ifdef KANJI + (void) TkSetWMCommand(winPtr, wmPtr->cmdArgv, wmPtr->cmdArgc); + #else XSetCommand(winPtr->display, winPtr->window, wmPtr->cmdArgv, wmPtr->cmdArgc); + #endif /* KANJI */ } if (wmPtr->clientMachine != NULL) { + #ifdef KANJI + (void) TkSetWMTextProperty(winPtr, XA_WM_CLIENT_MACHINE, + wmPtr->clientMachine); + #else if (XStringListToTextProperty(&wmPtr->clientMachine, 1, &textProp) != 0) { XSetWMClientMachine(winPtr->display, winPtr->window, &textProp); XFree((char *) textProp.value); } + #endif /* KANJI */ } } if (wmPtr->hints.initial_state == WithdrawnState) { *************** *** 822,827 **** --- 839,848 ---- ckalloc((unsigned) (strlen(argv[3]) + 1)); strcpy(wmPtr->clientMachine, argv[3]); if (!(wmPtr->flags & WM_NEVER_MAPPED)) { + #ifdef KANJI + return TkSetWMTextProperty(winPtr, XA_WM_CLIENT_MACHINE, + wmPtr->clientMachine); + #else XTextProperty textProp; if (XStringListToTextProperty(&wmPtr->clientMachine, 1, &textProp) != 0) { *************** *** 829,834 **** --- 850,856 ---- &textProp); XFree((char *) textProp.value); } + #endif /* KANJI */ } } else if ((c == 'c') && (strncmp(argv[1], "colormapwindows", length) == 0) && (length >= 3)) { *************** *** 940,946 **** --- 962,972 ---- wmPtr->cmdArgc = cmdArgc; wmPtr->cmdArgv = cmdArgv; if (!(wmPtr->flags & WM_NEVER_MAPPED)) { + #ifdef KANJI + (void) TkSetWMCommand(winPtr, wmPtr->cmdArgv, wmPtr->cmdArgc); + #else XSetCommand(winPtr->display, winPtr->window, cmdArgv, cmdArgc); + #endif } } else if ((c == 'd') && (strncmp(argv[1], "deiconify", length) == 0)) { if (argc != 3) { *************** *** 1238,1244 **** --- 1264,1274 ---- } else { wmPtr->iconName = Tk_GetUid(argv[3]); if (!(wmPtr->flags & WM_NEVER_MAPPED)) { + #ifdef KANJI + return TkSetWMTextProperty(winPtr, XA_WM_ICON_NAME, wmPtr->iconName); + #else XSetIconName(winPtr->display, winPtr->window, wmPtr->iconName); + #endif /* KANJI */ } } } else if ((c == 'i') && (strncmp(argv[1], "iconposition", length) == 0) *************** *** 1633,1638 **** --- 1663,1671 ---- } else { wmPtr->titleUid = Tk_GetUid(argv[3]); if (!(wmPtr->flags & WM_NEVER_MAPPED)) { + #ifdef KANJI + return TkSetWMTextProperty(winPtr, XA_WM_NAME, wmPtr->titleUid); + #else XTextProperty textProp; if (XStringListToTextProperty(&wmPtr->titleUid, 1, *************** *** 1640,1645 **** --- 1673,1679 ---- XSetWMName(winPtr->display, winPtr->window, &textProp); XFree((char *) textProp.value); } + #endif /* KANJI */ } } } else if ((c == 't') && (strncmp(argv[1], "transient", length) == 0) *************** *** 3854,3859 **** --- 3888,4027 ---- XFree((char *) oldPtr); } } + + #ifdef KANJI + /* + *---------------------------------------------------------------------- + * + * TkSetWMCommand -- + * + * If 'argv' contain kanji characters, covert them to COMPOUND_TEXT + * and call XSetTextProperty. Otherwise, just call XSetCommand. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + int + TkSetWMCommand(winPtr, argv, argc) + TkWindow *winPtr; + char **argv; + int argc; + { + int i; + int havekanji = 0; + int kanjiCode; + + for (i = 0; i < argc; i++) { + if (Tcl_KanjiString((Tcl_Interp *) NULL, argv[i], &kanjiCode) + != TCL_NOT_KANJI) { + havekanji = 1; + break; + } + } + + if (!havekanji) { + XSetCommand(winPtr->display, winPtr->window, argv, argc); + } else { /* str have kanji. set TEXT as COMPOUND_TEXT. */ + XTextProperty textProp; + wchar *wstr; + unsigned char *tmp; + int len = 0, olen = 0; + + if (!(textProp.value = (unsigned char *)ckalloc(sizeof(char)))) { + return TCL_ERROR; + } + for (i = 0; i < argc; i++) { + (void) Tcl_KanjiString((Tcl_Interp *) NULL, argv[i], &kanjiCode); + if (!(wstr = (wchar *)ckalloc( + (unsigned)(Tcl_KanjiEncode(kanjiCode, argv[i], NULL) + 1) * sizeof(wchar)))) { + return TCL_ERROR; + } + (void) Tcl_KanjiEncode(kanjiCode, argv[i], wstr); + tmp = (unsigned char *) Tk_WStrToCtext(wstr, -1); + len += strlen(tmp); + if (!(textProp.value = (unsigned char *) ckrealloc(textProp.value, ++len))) { + ckfree((char *) wstr); + ckfree((char *) tmp); + return TCL_ERROR; + } + strcpy(&(textProp.value[olen]), tmp); + ckfree((char *) tmp); + ckfree((char *) wstr); + olen = len; + } + textProp.encoding = Tk_InternAtom((Tk_Window)winPtr, "COMPOUND_TEXT"); + textProp.format = 8; + textProp.nitems = len; + XSetTextProperty(winPtr->display, winPtr->window, + &textProp, XA_WM_COMMAND); + ckfree((char *) textProp.value); + } + return TCL_OK; + } + + /* + *---------------------------------------------------------------------- + * + * TkSetWMTextProperty -- + * + * If 'str' contain kanji characters, convert them to COMPOUND_TEXT + * and call XSetTextProperty. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + int + TkSetWMTextProperty(winPtr, wmatom, str) + TkWindow *winPtr; + Atom wmatom; + char *str; + { + int kanjiCode; + + if (wmatom != XA_WM_CLIENT_MACHINE && wmatom != XA_WM_ICON_NAME && + wmatom != XA_WM_NAME) { + return TCL_ERROR; + } + + if (Tcl_KanjiString((Tcl_Interp *) NULL, str, &kanjiCode) == TCL_NOT_KANJI) { + XTextProperty textProp; + + if (XStringListToTextProperty(&str, 1, &textProp) != 0) { + XSetTextProperty(winPtr->display, winPtr->window, &textProp, wmatom); + XFree((char *) textProp.value); + } + } else { /* str have kanji. set TEXT as COMPOUND_TEXT. */ + XTextProperty textProp; + wchar *wstr; + + if (!(wstr = (wchar *) ckalloc( + (unsigned)(Tcl_KanjiEncode(kanjiCode, str, NULL) + 1) * sizeof(wchar)))) { + return TCL_ERROR; + } + (void) Tcl_KanjiEncode(kanjiCode, str, wstr); + textProp.value = (unsigned char *) Tk_WStrToCtext(wstr, -1); + textProp.encoding = Tk_InternAtom((Tk_Window)winPtr, "COMPOUND_TEXT"); + textProp.format = 8; + textProp.nitems = strlen(textProp.value); + XSetTextProperty(winPtr->display, winPtr->window, &textProp, wmatom); + ckfree((char *) textProp.value); + ckfree((char *) wstr); + } + return TCL_OK; + } + #endif /* KANJI */ /* *---------------------------------------------------------------------- diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/win/ReadmeJP.txt ./win/ReadmeJP.txt *** ../tk4.2/win/ReadmeJP.txt Thu Jan 1 09:00:00 1970 --- ./win/ReadmeJP.txt Fri Oct 18 13:15:25 1996 *************** *** 0 **** --- 1,51 ---- + WindowstHgPB + + [WindowsEBWFbgtHgw] + Tcl/Tk WindowsEBWFbgtHgw(1)XEBhEVXeｮ + _tHgw(2)WindowsｮtHgw\B + (1)B + (1)XEBhEVXeｮ_tHgw + + -*-Times-Medium-R-*--*-120-*-*-*-*-*-* + w()BTk Windows + Windows_tHgtHgIB + \[XR[hQB + tB[h#2(FamilyName) + Times, Helvetica, Courier, Symbol, Mincho, Gothic + B + L`ｮOa14Ak14OIAlr + 14|CguBAj[EBWFbgtH + gftHga14Ak14B + tB[h#2(FamilyName)MinchoGothic + VtgJISLN^ZbgFｯB + (2)WindowsｮtHgw + + {{lr } 24 {bold italic}} + wB3TuXgw + normal, bold, medium, heavy, thin, extralight, light, semibold, + extrabold, italic, oblique, underline, strikeout + B + lr tHg2oCg + VtgJISLN^ZbgFｯB + + [WindowsLoXPostScriptotHg] + LoXPostScripto@\gAtHgPostScript + AB + EWindowsｮtHgwAX_tHg`ｮw + KvBa14Ak14B + ETCY + -*-Times-Medium-R-*--*-120-*-*-*-*-*-* + tB[h#8(PointSize)wKvBtB[h#7 + (PixelSize)B + EtHg"Ryumin-Light-H"BtB[h#8 + (PointSize)XLB + \[XR[hQB + PostScriptt@ComFAWindows}V + \mFB + + [tHgtHgp] + AXL[tHgw-fontIvVlr + tHgwBt-kanjifonttHgOtHg + wG[B + --- + OP )Hiroaki Nakamura( hnakamur@da2.so-net.or.jp diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/win/makefile.vc ./win/makefile.vc *** ../tk4.2/win/makefile.vc Thu Oct 3 06:56:06 1996 --- ./win/makefile.vc Fri Oct 18 13:15:25 1996 *************** *** 26,31 **** --- 26,39 ---- # uncomment the following two lines to compile with TCL_MEM_DEBUG #DEBUGDEFINES =-DTCL_MEM_DEBUG + # To disable kanji handling, reverse the comment characters on the following + # lines. `KINPUT2' is the name of kanji input server. Actually, `KINPUT2' + # is the only kanji input server you can choose right now. :-) + # Warning: if you enable kanji handling for tk, you must enable kanji + # handling for tcl. + KANJI_FLAGS = -DKANJI + # KANJI_FLAGS = + # Make sure the VC++ tools are at the head of the path PATH=$(TOOLS32)\bin;$(PATH) *************** *** 43,49 **** -I$(ROOT)\bitmaps -I$(ROOT)\xlib -I$(ROOT) -I$(TCLDIR)\generic TK_DEFINES = \ ! -nologo $(DEBUGDEFINES) -DUSE_TCLALLOC=0 WISHOBJS = \ $(TMPDIR)\tkConsole.obj \ --- 51,62 ---- -I$(ROOT)\bitmaps -I$(ROOT)\xlib -I$(ROOT) -I$(TCLDIR)\generic TK_DEFINES = \ ! -nologo $(DEBUGDEFINES) $(KANJI_FLAGS) -DUSE_TCLALLOC=0 ! ! KANJIOBJS = \ ! $(TMPDIR)\tkWStr.obj \ ! $(TMPDIR)\tkCtext.obj ! # $(TMPDIR)\tkKinput2.obj \ WISHOBJS = \ $(TMPDIR)\tkConsole.obj \ *************** *** 142,148 **** $(TMPDIR)\tkTrig.obj \ $(TMPDIR)\tkUtil.obj \ $(TMPDIR)\tkVisual.obj \ ! $(TMPDIR)\tkWindow.obj TCLLIB = tcl76.lib TKLIB = tk42.lib --- 155,162 ---- $(TMPDIR)\tkTrig.obj \ $(TMPDIR)\tkUtil.obj \ $(TMPDIR)\tkVisual.obj \ ! $(TMPDIR)\tkWindow.obj \ ! $(KANJIOBJS) TCLLIB = tcl76.lib TKLIB = tk42.lib diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/win/tkWinDefault.h ./win/tkWinDefault.h *** ../tk4.2/win/tkWinDefault.h Tue Aug 27 02:09:59 1996 --- ./win/tkWinDefault.h Fri Oct 18 13:15:25 1996 *************** *** 54,60 **** --- 54,65 ---- #define DEF_BUTTON_DISABLED_FG_COLOR DISABLED #define DEF_BUTTON_DISABLED_FG_MONO "" #define DEF_BUTTON_FG BLACK + #ifdef KANJI + #define DEF_BUTTON_FONT "a14" + #define DEF_BUTTON_KANJIFONT "k14" + #else #define DEF_BUTTON_FONT "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*" + #endif /* KANJI */ #define DEF_BUTTON_HEIGHT "0" #define DEF_BUTTON_HIGHLIGHT_BG NORMAL_BG #define DEF_BUTTON_HIGHLIGHT BLACK *************** *** 115,120 **** --- 120,128 ---- #define DEF_CANVAS_SELECT_FG_COLOR BLACK #define DEF_CANVAS_SELECT_FG_MONO WHITE #define DEF_CANVAS_TAKE_FOCUS (char *) NULL + #ifdef KANJI + #define DEF_CANVAS_PS_KANJI_FONT "Ryumin-Light-H" + #endif /* KANJI */ #define DEF_CANVAS_WIDTH "10c" #define DEF_CANVAS_X_SCROLL_CMD "" #define DEF_CANVAS_X_SCROLL_INCREMENT "0" *************** *** 130,136 **** --- 138,149 ---- #define DEF_ENTRY_BORDER_WIDTH "2" #define DEF_ENTRY_CURSOR "xterm" #define DEF_ENTRY_EXPORT_SELECTION "1" + #ifdef KANJI + #define DEF_ENTRY_FONT "a14" + #define DEF_ENTRY_KANJIFONT "k14" + #else #define DEF_ENTRY_FONT "-Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*" + #endif /* KANJI */ #define DEF_ENTRY_FG BLACK #define DEF_ENTRY_HIGHLIGHT_BG NORMAL_BG #define DEF_ENTRY_HIGHLIGHT BLACK *************** *** 184,190 **** --- 197,208 ---- #define DEF_LISTBOX_BORDER_WIDTH "2" #define DEF_LISTBOX_CURSOR "" #define DEF_LISTBOX_EXPORT_SELECTION "1" + #ifdef KANJI + #define DEF_LISTBOX_FONT "a14" + #define DEF_LISTBOX_KANJIFONT "k14" + #else #define DEF_LISTBOX_FONT "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*" + #endif /* KANJI */ #define DEF_LISTBOX_FG BLACK #define DEF_LISTBOX_HEIGHT "10" #define DEF_LISTBOX_HIGHLIGHT_BG NORMAL_BG *************** *** 214,219 **** --- 232,240 ---- #define DEF_MENU_ENTRY_COMMAND (char *) NULL #define DEF_MENU_ENTRY_FG (char *) NULL #define DEF_MENU_ENTRY_FONT (char *) NULL + #ifdef KANJI + #define DEF_MENU_ENTRY_KANJIFONT (char *) NULL + #endif /* KANJI */ #define DEF_MENU_ENTRY_IMAGE (char *) NULL #define DEF_MENU_ENTRY_INDICATOR "1" #define DEF_MENU_ENTRY_LABEL (char *) NULL *************** *** 243,249 **** --- 264,275 ---- #define DEF_MENU_CURSOR "arrow" #define DEF_MENU_DISABLED_FG_COLOR DISABLED #define DEF_MENU_DISABLED_FG_MONO "" + #ifdef KANJI + #define DEF_MENU_FONT "a14" + #define DEF_MENU_KANJIFONT "k14" + #else #define DEF_MENU_FONT "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*" + #endif /* KANJI */ #define DEF_MENU_FG BLACK #define DEF_MENU_POST_COMMAND "" #define DEF_MENU_RELIEF "raised" *************** *** 270,276 **** --- 296,307 ---- #define DEF_MENUBUTTON_CURSOR "" #define DEF_MENUBUTTON_DISABLED_FG_COLOR DISABLED #define DEF_MENUBUTTON_DISABLED_FG_MONO "" + #ifdef KANJI + #define DEF_MENUBUTTON_FONT "a14" + #define DEF_MENUBUTTON_KANJIFONT "k14" + #else #define DEF_MENUBUTTON_FONT "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*" + #endif /* KANJI */ #define DEF_MENUBUTTON_FG BLACK #define DEF_MENUBUTTON_HEIGHT "0" #define DEF_MENUBUTTON_HIGHLIGHT_BG NORMAL_BG *************** *** 302,308 **** --- 333,344 ---- #define DEF_MESSAGE_BORDER_WIDTH "2" #define DEF_MESSAGE_CURSOR "" #define DEF_MESSAGE_FG BLACK + #ifdef KANJI + #define DEF_MESSAGE_FONT "a14" + #define DEF_MESSAGE_KANJIFONT "k14" + #else #define DEF_MESSAGE_FONT "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*" + #endif /* KANJI */ #define DEF_MESSAGE_HIGHLIGHT_BG NORMAL_BG #define DEF_MESSAGE_HIGHLIGHT BLACK #define DEF_MESSAGE_HIGHLIGHT_WIDTH "0" *************** *** 328,334 **** --- 364,375 ---- #define DEF_SCALE_COMMAND "" #define DEF_SCALE_CURSOR "" #define DEF_SCALE_DIGITS "0" + #ifdef KANJI + #define DEF_SCALE_FONT "a14" + #define DEF_SCALE_KANJIFONT "k14" + #else #define DEF_SCALE_FONT "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*" + #endif /* KANJI */ #define DEF_SCALE_FG_COLOR BLACK #define DEF_SCALE_FG_MONO BLACK #define DEF_SCALE_FROM "0" *************** *** 390,396 **** --- 431,442 ---- #define DEF_TEXT_CURSOR "xterm" #define DEF_TEXT_FG BLACK #define DEF_TEXT_EXPORT_SELECTION "1" + #ifdef KANJI + #define DEF_TEXT_FONT "a14" + #define DEF_TEXT_KANJIFONT "k14" + #else #define DEF_TEXT_FONT "-*-Courier-Medium-R-Normal--*-120-*-*-*-*-*-*" + #endif /* KANJI */ #define DEF_TEXT_HEIGHT "24" #define DEF_TEXT_HIGHLIGHT_BG NORMAL_BG #define DEF_TEXT_HIGHLIGHT BLACK diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/win/tkWinDraw.c ./win/tkWinDraw.c *** ../tk4.2/win/tkWinDraw.c Sun Oct 13 08:44:33 1996 --- ./win/tkWinDraw.c Fri Oct 18 13:15:26 1996 *************** *** 1279,1281 **** --- 1279,1373 ---- return (ScrollWindowEx(hwnd, dx, dy, &scrollRect, NULL, (HRGN) damageRgn, NULL, 0) == NULLREGION) ? 0 : 1; } + + #ifdef KANJI + + /* + *---------------------------------------------------------------------- + * + * TkDecodeSJISFromXChar2b -- + * + * Decode wide string from XChar2b to SJIS kanji string. + * + * Results: + * Bytes of the decoded kanji string. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + int + TkDecodeSJISFromXChar2b(xs, xsLen, ss) + _Xconst XChar2b *xs; + int xsLen; + unsigned char *ss; + { + _Xconst XChar2b *xChPtr; + int c1; + int c2; + int i; + int n = 0; + + for(i = 0, xChPtr = xs; (i < xsLen) && (xChPtr->byte1 || xChPtr->byte2); + xChPtr++, i++) { + c2 = xChPtr->byte2; + c1 = xChPtr->byte1; + if( c1 ) { + 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; + } else { + if( ss ) *ss++ = c2; + n++; + } + } + if( ss ) *ss = '\0'; + + return n; + } + + + /* + *---------------------------------------------------------------------- + * + * XDrawString16 -- + * + * Draw a single 16-bit character string in the current font. + * + * Results: + * None. + * + * Side effects: + * Renders the specified string in the drawable. + * + *---------------------------------------------------------------------- + */ + + void + XDrawString16(display, d, gc, x, y, string, length) + Display *display; + Drawable d; + GC gc; + int x; + int y; + _Xconst XChar2b *string; + int length; + { + unsigned char *mbs; + int mbsLen; + + mbsLen = TkDecodeSJISFromXChar2b(string, length, NULL); + mbs = (char *)ckalloc((unsigned )(mbsLen + 1)); + (void )TkDecodeSJISFromXChar2b(string, length, mbs); + XDrawString(display, d, gc, x, y, mbs, mbsLen); + ckfree(mbs); + } + #endif /* KANJI */ diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/win/tkWinFont.c ./win/tkWinFont.c *** ../tk4.2/win/tkWinFont.c Fri Sep 27 01:47:46 1996 --- ./win/tkWinFont.c Sun Nov 24 14:48:17 1996 *************** *** 53,58 **** --- 53,61 ---- int argc, argc2; char **argv, **argv2; int nameLen, i, pointSize = 0; + #ifdef KANJI + int kanjiCode; + #endif /* KANJI */ if (Tcl_SplitList(NULL, (char *) name, &argc, &argv) != TCL_OK) { return False; *************** *** 83,88 **** --- 86,97 ---- logfont->lfCharSet = SYMBOL_CHARSET; } else if (stricmp(logfont->lfFaceName, "WingDings") == 0) { logfont->lfCharSet = SYMBOL_CHARSET; + #ifdef KANJI + } else if (Tcl_KanjiString(NULL, logfont->lfFaceName, + &kanjiCode) == TCL_OK || + strcmp(logfont->lfFaceName, "Ryumin-Light-H") == 0) { + logfont->lfCharSet = SHIFTJIS_CHARSET; + #endif /* KANJI */ } /* *************** *** 169,174 **** --- 178,196 ---- int flen[13]; int i, len; + #ifdef KANJI + /* + * Special cases a14 and k14 are substituted to {{lr } 14 normal}. + */ + if (strcmp(name, "a14") == 0 || strcmp(name, "k14") == 0) { + memset(logfont, '\0', sizeof(LOGFONT)); + strcpy(logfont->lfFaceName, "lr "); + logfont->lfCharSet = SHIFTJIS_CHARSET; + logfont->lfHeight = -14; + logfont->lfWeight = FW_NORMAL; + return TRUE; + } + #endif /* KANJI */ /* * Valid font name patterns must have a leading '-' or '*'. */ *************** *** 260,265 **** --- 282,295 ---- logfont->lfCharSet = SYMBOL_CHARSET; } else if (stricmp(logfont->lfFaceName, "WingDings") == 0) { logfont->lfCharSet = SYMBOL_CHARSET; + #ifdef KANJI + } else if (stricmp(logfont->lfFaceName, "Mincho") == 0) { + strcpy(logfont->lfFaceName, "lr "); + logfont->lfCharSet = SHIFTJIS_CHARSET; + } else if (stricmp(logfont->lfFaceName, "Gothic") == 0) { + strcpy(logfont->lfFaceName, "lr SVbN"); + logfont->lfCharSet = SHIFTJIS_CHARSET; + #endif /* KANJI */ } } *************** *** 398,405 **** --- 428,439 ---- HFONT font; LOGFONT logfont; + #ifdef KANJI + if (XNameToFont(name, &logfont)) { + #else if (((name[0] == '-') || (name[0] == '*')) && XNameToFont(name, &logfont)) { + #endif /* KANJI */ font = CreateFontIndirect(&logfont); } else if (NameToFont(name, &logfont)) { font = CreateFontIndirect(&logfont); *************** *** 470,479 **** --- 504,530 ---- if (GetTextMetrics(dc, &tm)) { fontPtr->direction = FontLeftToRight; + #ifdef KANJI + if (tm.tmCharSet == SHIFTJIS_CHARSET) { + /* + * Below values are not accurate, but it's ok. + */ + fontPtr->min_byte1 = 0; + fontPtr->max_byte1 = 127; + fontPtr->min_char_or_byte2 = 0; + fontPtr->max_char_or_byte2 = 127; + } else { + fontPtr->min_byte1 = 0; + fontPtr->max_byte1 = 0; + fontPtr->min_char_or_byte2 = tm.tmFirstChar; + fontPtr->max_char_or_byte2 = tm.tmLastChar; + } + #else fontPtr->min_byte1 = 0; fontPtr->max_byte1 = 0; fontPtr->min_char_or_byte2 = tm.tmFirstChar; fontPtr->max_char_or_byte2 = tm.tmLastChar; + #endif /* KANJI */ fontPtr->all_chars_exist = True; fontPtr->default_char = tm.tmDefaultChar; fontPtr->n_properties = 0; *************** *** 721,723 **** --- 772,853 ---- return False; } + #ifdef KANJI + + EXTERN int TkDecodeSJISFromXChar2b _ANSI_ARGS_((_Xconst XChar2b *xs, int xsLen, + unsigned char *ss)); + + /* + *---------------------------------------------------------------------- + * + * XTextWidth16 -- + * + * Compute the width of an 16-bit character string. + * + * Results: + * Returns the computed width of the specified string. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + int + XTextWidth16(font_struct, string, count) + XFontStruct *font_struct; + _Xconst XChar2b *string; + int count; + { + unsigned char *mbs; + int mbsLen; + int result; + + mbsLen = TkDecodeSJISFromXChar2b(string, count, NULL); + mbs = (char *)ckalloc((unsigned )(mbsLen + 1)); + (void )TkDecodeSJISFromXChar2b(string, count, mbs); + result = XTextWidth(font_struct, mbs, mbsLen); + ckfree(mbs); + return result; + } + + /* + *---------------------------------------------------------------------- + * + * XTextExtents16 -- + * + * Compute the bounding box for a 16-bit character string. + * + * Results: + * Sets the direction_return, ascent_return, descent_return, and + * overall_return values as defined by Xlib. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + void + XTextExtents16(font_struct, string, nchars, direction_return, ascent_return, + descent_return, overall_return) + XFontStruct *font_struct; + _Xconst XChar2b *string; + int nchars; + int *direction_return; + int *ascent_return; + int *descent_return; + XCharStruct *overall_return; + { + unsigned char *mbs; + int mbsLen; + int result; + + mbsLen = TkDecodeSJISFromXChar2b(string, nchars, NULL); + mbs = (char *)ckalloc((unsigned )(mbsLen + 1)); + (void )TkDecodeSJISFromXChar2b(string, nchars, mbs); + XTextExtents(font_struct, mbs, mbsLen, direction_return, ascent_return, + descent_return, overall_return); + ckfree(mbs); + } + #endif /* KANJI */ diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tk4.2/win/tkWinX.c ./win/tkWinX.c *** ../tk4.2/win/tkWinX.c Tue Oct 15 05:56:34 1996 --- ./win/tkWinX.c Fri Oct 18 13:15:27 1996 *************** *** 493,498 **** --- 493,501 ---- return DefWindowProc(hwnd, message, wParam, lParam); } + #ifdef KANJI + #define IS_SJIS(c) (((c) >= 0x81 && (c) <= 0x9f) || ((c) >= 0xe0 && (c) <= 0xfc)) + #endif /* KANJI */ /* *---------------------------------------------------------------------- * *************** *** 584,589 **** --- 587,595 ---- return DefWindowProc(hwnd, message, wParam, lParam); } + #ifdef KANJI + #define IS_SJIS(c) (((c) >= 0x81 && (c) <= 0x9f) || ((c) >= 0xe0 && (c) <= 0xfc)) + #endif /* KANJI */ /* *---------------------------------------------------------------------- * *************** *** 701,706 **** --- 707,715 ---- POINT clientPoint; POINTS rootPoint; /* Note: POINT and POINTS are different */ DWORD msgPos; + #ifdef KANJI + static unsigned char c1 = 0; + #endif /* KANJI */ /* * Compute the screen and window coordinates of the event. *************** *** 808,815 **** --- 817,854 ---- event.type = KeyPress; event.xany.send_event = -1; event.xkey.keycode = 0; + #ifdef KANJI + /* + * SJIS2oCgvB + */ + if (c1) { + /* + * SJIS2oCgB1oCg + * B + */ + event.xkey.nchars = 2; + event.xkey.trans_chars[0] = c1; + event.xkey.trans_chars[1] = (unsigned char) wParam; + c1 = 0; + } else { + if (IS_SJIS((unsigned char) wParam)) { + /* + * SJIS1oCgB2oCg + * B + */ + c1 = (unsigned char) wParam; + return; + } + /* + * ASCIIB + */ + event.xkey.nchars = 1; + event.xkey.trans_chars[0] = (char) wParam; + } + #else event.xkey.nchars = 1; event.xkey.trans_chars[0] = (char) wParam; + #endif /* KANJI */ Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL); event.type = KeyRelease; break;