diff options
| author | Shashank | 2017-05-29 12:40:26 +0530 |
|---|---|---|
| committer | Shashank | 2017-05-29 12:40:26 +0530 |
| commit | 0345245e860375a32c9a437c4a9d9cae807134e9 (patch) | |
| tree | ad51ecbfa7bcd3cc5f09834f1bb8c08feaa526a4 /modules/tclsci/tcl/sciGUI | |
| download | scilab_for_xcos_on_cloud-0345245e860375a32c9a437c4a9d9cae807134e9.tar.gz scilab_for_xcos_on_cloud-0345245e860375a32c9a437c4a9d9cae807134e9.tar.bz2 scilab_for_xcos_on_cloud-0345245e860375a32c9a437c4a9d9cae807134e9.zip | |
CMSCOPE changed
Diffstat (limited to 'modules/tclsci/tcl/sciGUI')
36 files changed, 5317 insertions, 0 deletions
diff --git a/modules/tclsci/tcl/sciGUI/data/dontshow.txt b/modules/tclsci/tcl/sciGUI/data/dontshow.txt new file mode 100755 index 000000000..9a9e0b823 --- /dev/null +++ b/modules/tclsci/tcl/sciGUI/data/dontshow.txt @@ -0,0 +1,33 @@ +demolist +ierr +browsevar +show_startupinfo +LCC +%toolboxes_dir +%toolboxes +%sciGUIPath +modelica_libs +home +PWD +TMPDIR +$ +%helps +LANGUAGE +WSCI +SCI +%F +%T +%z +%s +%nan +%inf +COMPILER +%gtk +%tk +%t +%f +%eps +%io +%i +%e +%pi diff --git a/modules/tclsci/tcl/sciGUI/data/error.gif b/modules/tclsci/tcl/sciGUI/data/error.gif Binary files differnew file mode 100755 index 000000000..a4ed2e9d3 --- /dev/null +++ b/modules/tclsci/tcl/sciGUI/data/error.gif diff --git a/modules/tclsci/tcl/sciGUI/data/giftable.txt b/modules/tclsci/tcl/sciGUI/data/giftable.txt new file mode 100755 index 000000000..eda2bf752 --- /dev/null +++ b/modules/tclsci/tcl/sciGUI/data/giftable.txt @@ -0,0 +1,40 @@ +# List of .gif files ans internal names +# This file is part of sciGUI toolbox +# by Jaime Urzua +# mailto:jaime_urzua@yahoo.com +error:error.gif +hourglass:hourglass.gif +info:info.gif +passwd:passwd.gif +question:question.gif +scilab01:scilab01.gif +warning:warning.gif +tp00:tp00.gif +tp01:tp01.gif +tp02:tp02.gif +tp04:tp04.gif +tp05:tp05.gif +tp06:tp06.gif +tp08:tp08.gif +tp10:tp10.gif +tp15:tp15.gif +tp16:tp16.gif +tp17:tp17.gif +#Polyline:tpPolyline.gif +#Patch:tpPatch.gif. +#Agregation:tpAgregation.gif +#Axes:tpAxes.gif +#Legend:tpLegend.gif +#Rectangle:tpRectangle.gif +#Arc:tpArc.gif +#Grayplot:tpGrayplot.gif +#Matplot:tpMatplot.gif +#Fec:tpFec.gif +#Segs:tpSegs.gif +#Champ:tpChamp.gif +#Text:tpText.gif +#Title:tpTitle.gif +#Plot3d:tpPlot3d.gif +#Fac3d:tpFac3d.gif +#Param3d:tpParam3d.gif +#Axis:tpAxis.gif
\ No newline at end of file diff --git a/modules/tclsci/tcl/sciGUI/data/hourglass.gif b/modules/tclsci/tcl/sciGUI/data/hourglass.gif Binary files differnew file mode 100755 index 000000000..bac625a3e --- /dev/null +++ b/modules/tclsci/tcl/sciGUI/data/hourglass.gif diff --git a/modules/tclsci/tcl/sciGUI/data/icontable.txt b/modules/tclsci/tcl/sciGUI/data/icontable.txt new file mode 100755 index 000000000..fbfc5c965 --- /dev/null +++ b/modules/tclsci/tcl/sciGUI/data/icontable.txt @@ -0,0 +1,14 @@ +iconViewTree:R0lGODlhEAAQAIIAAAQCBPwCBDQyNPz+/PzerAAAAAAAAAAAACH5BAEAAAEALAAAAAAQABAAAAMuCLHcri4yGISlj4kxcANgNRBQCIbL6U1Su7bB62rXvGydG25kqpwfIGxILBr9CQAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7 +iconFind:R0lGODlhEAAQAIUAAPwCBGxqbERCRGRiZMTW1NTm5Ky6vOTy9Nzy9MTq7Kze5ISChOz6/OT29Lzu7IzW5GzGzLza3NTy9Nz29Kzq9Ize7HTGzHTK1CQmJLzu9LTq7HTW5GTCzITO1KzS1Iza5FTK1ESyvHzGzDyqtJTW3LTa3Mzq7KzW3IxuTMxyLOSaPJxaTAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAaNQIAQECgOj4LhIEAoEAKD4zFgOCASCoUhMFwshIEDo+F4QBxcwELADkQkEwmlYrlEuGsBZlBIZDQVGxwdElEAGBhEHgoPHxsgISIeaUcDDhcQECEjaFJgBg4kIh0JBgKGUlAlJicDpygonmBGrikqsUieAiu2uLlIvLdCXrIAu715SUlSxwN5icVsAH5BACH+aENyZWF0ZWQgYnkgQk1QVG9HSUYgUHJvIHZlcnNpb24gMi41DQqpIERldmVsQ29yIDE5OTcsMTk5OC4gQWxsIHJpZ2h0cyByZXNlcnZlZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs= +iconNext:R0lGODlhGAAYAIQAAPwCBARCZKze7IzK3IS+1Hy6zHSyzGyuxGSmxFyevFyatFSStEyOrESGrDx+pDRynCxulBxijCRmlAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAYABgAAAWSICCOZGmeZxCgLBkIwtqy7xDP6EvYMu4KhODNN3oVjoahScVsCg5Qw0FZhFmvT6iWCnghEohw4gAOm8PUV2LNbrvXypdCkZjP6/b8vPda+P+AgQwLDHwCDA0MiomKjY6FPw2Sk5IOlZQ9RU1NDp2eDpkzAQ8OpKShog+qqqipEA8QraIREhGys7ZEKbe6vb4iBiEAIf5oQ3JlYXRlZCBieSBCTVBUb0dJRiBQcm8gdmVyc2lvbiAyLjUNCqkgRGV2ZWxDb3IgMTk5NywxOTk4LiBBbGwgcmlnaHRzIHJlc2VydmVkLg0KaHR0cDovL3d3dy5kZXZlbGNvci5jb20AOw== +iconPrevious:R0lGODlhGAAYAIQAAPwCBARCZKze7IzK3IS+1Hy6zGyuxHSyzGSmxFyevFyatEyOrFSStESGrDx+pDRynCxulCRmlBxijAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAYABgAAAWRICCOZGmeZhCgLBkIwtqi7xDP50vYMj7qBMLNJ3oVjoWh72UwHJoxlVSaEjSvBph2qwS8EOAwODEuI3qvhHrNbq/RAoV8Tk/I7Qo7esHgM/6AgYB8PV4Lh4iJioiFXg2PDpCSDZGPDY1eDpqbDlOeNA8OoaGYMwEPqKilpg8QrqumERESsKYStEQ5tbm8vSJ2IQAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7 +iconPencil:R0lGODlhFgAWAIMAAASC/IQCBPwCBPyChMQCBPzCxAQCBPz+/MzKzISChKyqrDQyNEQCBAAAAAAAAAAAACH5BAEAAAAALAAAAAAWABYAAARYEMhJ6wxiEMtpIAWxddwXiqRlikSQeiAbuC+wirNR322gv7zcLobzDU+9XypoBBKTR1lz+RTWDgip8nUwZK1XLyIx5XoVicX2RUAo1DVKi7GOBxjxfNwQAQAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7 +iconTrash:R0lGODlhFgAWAIUAAPwCBAQCBERGRExOTDQyNISChBQSFCQiJCwuLPT29Nze3GxqbDw6PGxubHR2dJyanLSytJSWlJSSlOzq7Pz6/Nza3Ly6vFRWVBQWFIyKjMTCxHx6fIyOjLS2tOTi5PTy9OTm5Hx+fNTW1KyurKSmpJyenExKTMzKzKSipFxeXCwqLMzOzKyqrMTGxLy+vHRydBwaHNTS1DQ2NAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAWABYAAAb8QIBwSCwaj8KAMoA8LgUDQsFwQByay4RiwWg4GA9IRGk0SCYJSsUCsVwwGQ1EsmESD5xOp+L5gDwhBRIZDhcDdkMGDgEiIxAkJQ8Ok5MmAohDAQ1xJxUlKCUlEg0pKpiZJRoLCxmtCw1eURhOcR4rbQ8cGRwLAwgGtBYTDywtGRKjvQTARgEZLhMcKC0OrQMvAirMRc7CHCTU1g2+20TO0NIn1RwDCya/wdHT1Rnt5LToKOq79trx0tR02YPX7Jm8fRxMOIhSLhOJE/LCJSTlr5kFEBQsWDiR4UGGBgsuHDg1BEYAfTE6oEBR4AIBAiS5yWBAAAGBAyaPGAgCACH+aENyZWF0ZWQgYnkgQk1QVG9HSUYgUHJvIHZlcnNpb24gMi41DQqpIERldmVsQ29yIDE5OTcsMTk5OC4gQWxsIHJpZ2h0cyByZXNlcnZlZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs= +iconFilter:R0lGODlhFgAWAIQAAPwCBAQCBAwKDMzKzMTGxNTS1MzOzAQGBLS2tLy+vKyqrLSytLy6vMTCxBQWFKyurCQmJBweHAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAWABYAAAV7ICCOZGmeaHoGbKuOAjsQhVG764EgyT7YhaCBVQogFMhFImEABoUBknFxRDAazac2Kg00djystkA0sQ4BgzgYK6+Ch/bBseOmAmMD4gF5ifBCDwoRfiOABgyEhYYFCA6LUo19kH+Nj5QAaQh2kHibmJkFBJydpKCnfnYhACH+aENyZWF0ZWQgYnkgQk1QVG9HSUYgUHJvIHZlcnNpb24gMi41DQqpIERldmVsQ29yIDE5OTcsMTk5OC4gQWxsIHJpZ2h0cyByZXNlcnZlZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs= +iconReload:R0lGODlhFgAWAIYAAPwCBCRSFCRSHBw+DBxCFCQ6FBwyDBQWBBxGFCxyLGTChMzqzLzmvHzKjDyOTER+RERyNDSqXNzy3LzivFS+fCyCPBQmBCQiBBxKFBQqDOTy3LTitES2dDR+PCxuJOT25KTarCx+PESSTCxKHDSeVCyKRNT21ESWVDSGPBQyDAQCBBQSFDRuLDSyZDySTGzChCRiJKSmpExKTDS2ZGzGhLy+vGxqbISChDSKRMzKzGxubDQ2NIyOjCQiJCwqLBQWFCwuLKSipERCRERGRHR2dAwKDDw6PFRWVIyKjCQmJFRSVBwaHKyurAQGBExOTBweHFxeXAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAWABYAAAf9gACCg4IBAgMEBQYHhI2ECAkKCwwNDg8QBAOOhAQREhMUFQgWBxcHGBmbggkaGxwPB4yDB6SbBJIKHQaqtY0eHyAhsqrDgx4aCiKpqoQHAyMjJBMKJaSxzAAHIRsmJgonKA0LHSmDKiuOBywRLSQuLyEwwyoxMuiN6iUzNBXy5jU2bsgoJugABBz95uXQsUMGD3vpPPgTpKIGwx4+HMr4kW4YkCA2hAzxAQSIECI+imBTwVIFESNHerRUgc0cEiFHkjiiyYzeDiVLdvLcySSkkKGEWiZVweSGkIHMmvQosoQlkaZOjvhosvKJjIAxoOAsgpRZkQNLnvSoqspAIAAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7 +iconHome:R0lGODlhFgAWAIYAAPwCBAQCBCQiJNze3ERCROTi5MzGzLy6vDw6PKyqrKyurBQSFGRiZGxqbGRmZISChEQ+RExKTExOTHRydDQyNOTe5FROVLSurCwqLMTCxPT29Pz6/LSutFxeXLyytLSytPz+/JSWlKympPTq7KSipNzW3BwaHHx6fKx2VJRWNHQmBFweDOzq7Ly+vNTW1JxWNLSajPTe1Ny6pKxWJNTS1IyOjJRmbPTi3OzKrNSSXMSGVHQiBHx+fJSSlPzy9IxOVOzWxOSyjNSCPLxeDJyWnIRGTOTGtMxmDLRWBHwqBIxGTLRSDDQuNNSunKxKBGwyNMSafMxqHMReDKRGDPTu9LxuPLxaDJQ+DIR+hGQqNIQyBGQiBNTO1EQKBAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAWABYAAAf/gACCg4QBAYSIiYQCAwQCiokEhwACBQYHBAiQhAiHlQYJCgkEC5uCkp8MDQ4NDwylmwgQlgQRERIEBBOkmxQVBgQWFwUFFxEEDLyJGAUZtQoFGhsFHLYdyoOVHsEf0SAbIAUex8mwlAUhtSIFG+3uIyTWvAIGJMEkJe76GyXbEeWUBJg4USKaBhQpVKzYoIFFiwYUBBJa8MAFCw0vYMSQMWOhBhoTKCQSUKMEiw02buDIoWOHBg0GeIhEFKAHDR8afgAJImSIioYliMws1MPkhiJGchxBkmTDCBo1hg4KQMTiBiUyhBxZ8pNFiR5MEtU0WqSJVidJNDyNKraHC5xPNKBEkTLlJ5WvUgWNvfikyhArV34+7ZEXQAAsB2iUyHLlihYtW0pwOYAFgyJDmDNr7jIIWiAAIf5oQ3JlYXRlZCBieSBCTVBUb0dJRiBQcm8gdmVyc2lvbiAyLjUNCqkgRGV2ZWxDb3IgMTk5NywxOTk4LiBBbGwgcmlnaHRzIHJlc2VydmVkLg0KaHR0cDovL3d3dy5kZXZlbGNvci5jb20AOw== +iconQuit:R0lGODlhGAAYAIYAAASC/GQCBGQKDGQKBNxWTOxaTOQuBNxSRNQqBNwqBNwmBOQqBLwqDLQqFNyShNQmBMwmBMQqDKwqFPTy9NyalNQyDMweBLwmDMyWjPz29Pz6/NQ6HMwiBPTu7NyilMQuFPz+/OyqnMQeBLwiBNSilKQuHOS6tNReTMw2HNyelMyenOy6tNRmVMxCLMQmDLwaBNSelMQ+LLQWBKweDJwqHNSmpNy2tMRiVLwiDLQaBKwSBJQeFMSKhLQuHKwWBKQSBKQaDKQOBJQaFMSSjLxeVNSalIwSDKwyLKQqHMyalJwOBJwKBJwaFKxOTKQmHIwGBJwmJJQWDJQGBJwWDKw+PJwiHJQSDGwODIQCBAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAYABgAAAf/gACCg4SFhoeEAQICAwMBAYiHjwQFlJaPkYMBBQUGnp8GBQeQkQEHCAkKBgusCgmoBaSGpgwNDg8KuQgQthEPD7KaBxASExMUFRYPFw0YGRobycEAmxwOEx0aHh8WEhgTGiAhGxbBAQQcIiMUGR0TJCXf4SYnKBzlmgUWFiIMKcYdVEzIAGIFixYuLLyQde6FwxcSYHRw98wEixguHjIs8EKGxxk0arjrYONGDBw5PMpgSECHDhk6dvAAl61DjR4+Xr7cqOMHEJkagtrApgHGDJcuNwbRIWQIOA02iIjMVmRGkKvmChjh8QwqkSNIkjwtAkTJtHNKjAj9KmQJkyThRZo4WTKN2oEnUEg0ORJFit8pSZpQqVJXUIAnVqDsMPKkcWMrQqpcyRQAi+UnWDBjzly40CPLoC1jypTokenOpFOrVi0jEAAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7 +ClosedBook:R0lGODlhEAAQAIQAAPwCBAQCBDyKhDSChGSinFSWlEySjCx+fHSqrGSipESOjCR6dKTGxISytIy6vFSalBxydAQeHHyurAxubARmZCR+fBx2dDyKjPz+/MzKzLTS1IyOjAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAVkICCOZGmKQXCWqTCoa0oUxnDAZIrsSaEMCxwgwGggHI3E47eA4AKRogQxcy0mFFhgEW3MCoOKBZsdUrhFxSUMyT7P3bAlhcnk4BoHvb4RBuABGHwpJn+BGX1CLAGJKzmKjpF+IQAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7 +OpenBook:R0lGODlhEAAQAIUAAPwCBAQCBExCNGSenHRmVCwqJPTq1GxeTHRqXPz+/DwyJPTq3Ny+lOzexPzy5HRuVFSWlNzClPTexIR2ZOzevPz29AxqbPz6/IR+ZDyKjPTy5IyCZPz27ESOjJySfDSGhPTm1PTizJSKdDSChNzWxMS2nIR6ZKyijNzOrOzWtIx+bLSifNTGrMy6lIx+ZCRWRAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAaeQEAAQCwWBYJiYEAoGAFIw0E5QCScAIVikUgQqNargtFwdB9KSDhxiEjMiUlgHlB3E48IpdKdLCxzEAQJFxUTblwJGH9zGQgVGhUbbhxdG4wBHQQaCwaTb10emB8EBiAhInp8CSKYIw8kDRSfDiUmJ4xCIxMoKSoRJRMrJyy5uhMtLisTLCQkC8bHGBMj1daARgEjLyN03kPZc09FfkEAIf5oQ3JlYXRlZCBieSBCTVBUb0dJRiBQcm8gdmVyc2lvbiAyLjUNCqkgRGV2ZWxDb3IgMTk5NywxOTk4LiBBbGwgcmlnaHRzIHJlc2VydmVkLg0KaHR0cDovL3d3dy5kZXZlbGNvci5jb20AOw== +File:R0lGODlhEAAQAIUAAPwCBFxaXNze3Ly2rJSWjPz+/Ozq7GxqbJyanPT29HRydMzOzDQyNIyKjERCROTi3Pz69PTy7Pzy7PTu5Ozm3LyqlJyWlJSSjJSOhOzi1LyulPz27PTq3PTm1OzezLyqjIyKhJSKfOzaxPz29OzizLyidIyGdIyCdOTOpLymhOzavOTStMTCtMS+rMS6pMSynMSulLyedAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAaQQIAQECgajcNkQMBkDgKEQFK4LFgLhkMBIVUKroWEYlEgMLxbBKLQUBwc52HgAQ4LBo049atWQyIPA3pEdFcQEhMUFYNVagQWFxgZGoxfYRsTHB0eH5UJCJAYICEinUoPIxIcHCQkIiIllQYEGCEhJicoKYwPmiQeKisrKLFKLCwtLi8wHyUlMYwM0tPUDH5BACH+aENyZWF0ZWQgYnkgQk1QVG9HSUYgUHJvIHZlcnNpb24gMi41DQqpIERldmVsQ29yIDE5OTcsMTk5OC4gQWxsIHJpZ2h0cyByZXNlcnZlZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs= + diff --git a/modules/tclsci/tcl/sciGUI/data/info.gif b/modules/tclsci/tcl/sciGUI/data/info.gif Binary files differnew file mode 100755 index 000000000..0286c268d --- /dev/null +++ b/modules/tclsci/tcl/sciGUI/data/info.gif diff --git a/modules/tclsci/tcl/sciGUI/data/initial b/modules/tclsci/tcl/sciGUI/data/initial new file mode 100755 index 000000000..b0b27ada1 --- /dev/null +++ b/modules/tclsci/tcl/sciGUI/data/initial @@ -0,0 +1,3 @@ +.controls "" +.buttons "back sep stop sep forw" + diff --git a/modules/tclsci/tcl/sciGUI/data/initial.help b/modules/tclsci/tcl/sciGUI/data/initial.help new file mode 100755 index 000000000..b0b27ada1 --- /dev/null +++ b/modules/tclsci/tcl/sciGUI/data/initial.help @@ -0,0 +1,3 @@ +.controls "" +.buttons "back sep stop sep forw" + diff --git a/modules/tclsci/tcl/sciGUI/data/ndemo_tx01.txt b/modules/tclsci/tcl/sciGUI/data/ndemo_tx01.txt new file mode 100755 index 000000000..8f01cb84d --- /dev/null +++ b/modules/tclsci/tcl/sciGUI/data/ndemo_tx01.txt @@ -0,0 +1,7 @@ +Scilab is a scientific software package for numerical computations providing a powerful open computing environment for engineering and scientific applications. Developed since 1990 by researchers from INRIA and ENPC, it is now maintained and developed by Scilab Consortium since its creation in May 2003. + +Distributed freely and open source (see the license) via the Internet since 1994, Scilab is currently being used in educational and industrial environments around the world. + +Scilab includes hundreds of mathematical functions with the possibility to add interactively programs from various languages (C, Fortran...). It has sophisticated data structures (including lists, polynomials, rational functions, linear systems...), an interpreter and a high level programming language. + +Scilab has been designed to be an open system where the user can define new data types and operations on these data types by using overloading. diff --git a/modules/tclsci/tcl/sciGUI/data/passwd.gif b/modules/tclsci/tcl/sciGUI/data/passwd.gif Binary files differnew file mode 100755 index 000000000..7536cd851 --- /dev/null +++ b/modules/tclsci/tcl/sciGUI/data/passwd.gif diff --git a/modules/tclsci/tcl/sciGUI/data/question.gif b/modules/tclsci/tcl/sciGUI/data/question.gif Binary files differnew file mode 100755 index 000000000..c6522fe38 --- /dev/null +++ b/modules/tclsci/tcl/sciGUI/data/question.gif diff --git a/modules/tclsci/tcl/sciGUI/data/scilab01.gif b/modules/tclsci/tcl/sciGUI/data/scilab01.gif Binary files differnew file mode 100755 index 000000000..e2a5884f6 --- /dev/null +++ b/modules/tclsci/tcl/sciGUI/data/scilab01.gif diff --git a/modules/tclsci/tcl/sciGUI/data/tp00.gif b/modules/tclsci/tcl/sciGUI/data/tp00.gif Binary files differnew file mode 100755 index 000000000..cf2131a22 --- /dev/null +++ b/modules/tclsci/tcl/sciGUI/data/tp00.gif diff --git a/modules/tclsci/tcl/sciGUI/data/tp01.gif b/modules/tclsci/tcl/sciGUI/data/tp01.gif Binary files differnew file mode 100755 index 000000000..7b7b649e9 --- /dev/null +++ b/modules/tclsci/tcl/sciGUI/data/tp01.gif diff --git a/modules/tclsci/tcl/sciGUI/data/tp02.gif b/modules/tclsci/tcl/sciGUI/data/tp02.gif Binary files differnew file mode 100755 index 000000000..6dde30e63 --- /dev/null +++ b/modules/tclsci/tcl/sciGUI/data/tp02.gif diff --git a/modules/tclsci/tcl/sciGUI/data/tp04.gif b/modules/tclsci/tcl/sciGUI/data/tp04.gif Binary files differnew file mode 100755 index 000000000..e6d0aeaa8 --- /dev/null +++ b/modules/tclsci/tcl/sciGUI/data/tp04.gif diff --git a/modules/tclsci/tcl/sciGUI/data/tp05.gif b/modules/tclsci/tcl/sciGUI/data/tp05.gif Binary files differnew file mode 100755 index 000000000..9982ecaea --- /dev/null +++ b/modules/tclsci/tcl/sciGUI/data/tp05.gif diff --git a/modules/tclsci/tcl/sciGUI/data/tp06.gif b/modules/tclsci/tcl/sciGUI/data/tp06.gif Binary files differnew file mode 100755 index 000000000..342ba2b48 --- /dev/null +++ b/modules/tclsci/tcl/sciGUI/data/tp06.gif diff --git a/modules/tclsci/tcl/sciGUI/data/tp08.gif b/modules/tclsci/tcl/sciGUI/data/tp08.gif Binary files differnew file mode 100755 index 000000000..acb9e5b6d --- /dev/null +++ b/modules/tclsci/tcl/sciGUI/data/tp08.gif diff --git a/modules/tclsci/tcl/sciGUI/data/tp10.gif b/modules/tclsci/tcl/sciGUI/data/tp10.gif Binary files differnew file mode 100755 index 000000000..54f61f99a --- /dev/null +++ b/modules/tclsci/tcl/sciGUI/data/tp10.gif diff --git a/modules/tclsci/tcl/sciGUI/data/tp15.gif b/modules/tclsci/tcl/sciGUI/data/tp15.gif Binary files differnew file mode 100755 index 000000000..e97668072 --- /dev/null +++ b/modules/tclsci/tcl/sciGUI/data/tp15.gif diff --git a/modules/tclsci/tcl/sciGUI/data/tp16.gif b/modules/tclsci/tcl/sciGUI/data/tp16.gif Binary files differnew file mode 100755 index 000000000..5caafc074 --- /dev/null +++ b/modules/tclsci/tcl/sciGUI/data/tp16.gif diff --git a/modules/tclsci/tcl/sciGUI/data/tp17.gif b/modules/tclsci/tcl/sciGUI/data/tp17.gif Binary files differnew file mode 100755 index 000000000..e6776ab46 --- /dev/null +++ b/modules/tclsci/tcl/sciGUI/data/tp17.gif diff --git a/modules/tclsci/tcl/sciGUI/data/warning.gif b/modules/tclsci/tcl/sciGUI/data/warning.gif Binary files differnew file mode 100755 index 000000000..c78eee99b --- /dev/null +++ b/modules/tclsci/tcl/sciGUI/data/warning.gif diff --git a/modules/tclsci/tcl/sciGUI/license.txt b/modules/tclsci/tcl/sciGUI/license.txt new file mode 100755 index 000000000..c96ea8bf6 --- /dev/null +++ b/modules/tclsci/tcl/sciGUI/license.txt @@ -0,0 +1,16 @@ +sciGUI +Copyright (c) 2004 Jaime Urzua Grez + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. diff --git a/modules/tclsci/tcl/sciGUI/local_extra/balloonhelp.tcl b/modules/tclsci/tcl/sciGUI/local_extra/balloonhelp.tcl new file mode 100755 index 000000000..0606bfbb1 --- /dev/null +++ b/modules/tclsci/tcl/sciGUI/local_extra/balloonhelp.tcl @@ -0,0 +1,250 @@ +## +## Copyright 1996-8 Jeffrey Hobbs, jeff.hobbs@acm.org +## +## Initiated: 28 October 1996 +## +package provide BalloonHelp 2.0 + +##------------------------------------------------------------------------ +## PROCEDURE +## balloonhelp +## +## DESCRIPTION +## Implements a balloon help system +## +## ARGUMENTS +## balloonhelp <option> ?arg? +## +## clear ?pattern? +## Stops the specified widgets (defaults to all) from showing balloon +## help. +## +## delay ?millisecs? +## Query or set the delay. The delay is in milliseconds and must +## be at least 50. Returns the delay. +## +## disable OR off +## Disables all balloon help. +## +## enable OR on +## Enables balloon help for defined widgets. +## +## <widget> ?-index index? ?message? +## If -index is specified, then <widget> is assumed to be a menu +## and the index represents what index into the menu (either the +## numerical index or the label) to associate the balloon help +## message with. Balloon help does not appear for disabled menu items. +## If message is {}, then the balloon help for that +## widget is removed. The widget must exist prior to calling +## balloonhelp. The current balloon help message for <widget> is +## returned, if any. +## +## RETURNS: varies (see methods above) +## +## NAMESPACE & STATE +## The global array BalloonHelp is used. Procs begin with BalloonHelp. +## The overrideredirected toplevel is named $BalloonHelp(TOPLEVEL). +## +## EXAMPLE USAGE: +## balloonhelp .button "A Button" +## balloonhelp .menu -index "Load" "Loads a file" +## +##------------------------------------------------------------------------ + +namespace eval ::Widget::BalloonHelp {; + +namespace export -clear balloonhelp +variable BalloonHelp + +## The extra :hide call in <Enter> is necessary to catch moving to +## child widgets where the <Leave> event won't be generated +bind Balloons <Enter> [namespace code { + #BalloonHelp:hide + variable BalloonHelp + set BalloonHelp(LAST) -1 + if {$BalloonHelp(enabled) && [info exists BalloonHelp(%W)]} { + set BalloonHelp(AFTERID) [after $BalloonHelp(DELAY) \ + [namespace code [list show %W $BalloonHelp(%W)]]] + } +}] + +bind Menu <<MenuSelect>> [namespace code { menuMotion %W }] +bind Balloons <Leave> [namespace code hide] +bind Balloons <Any-KeyPress> [namespace code hide] +bind Balloons <Any-Button> [namespace code hide] + +array set BalloonHelp { + enabled 1 + DELAY 500 + AFTERID {} + LAST -1 + TOPLEVEL .__balloonhelp__ +} + +proc balloonhelp {w args} { + variable BalloonHelp + switch -- $w { + clear { + if {[llength $args]==0} { set args .* } + clear $args + } + delay { + if {[llength $args]} { + if {![regexp {^[0-9]+$} $args] || $args<50} { + return -code error "BalloonHelp delay must be an\ + integer greater than 50 (delay is in millisecs)" + } + return [set BalloonHelp(DELAY) $args] + } else { + return $BalloonHelp(DELAY) + } + } + off - disable { + set BalloonHelp(enabled) 0 + hide + } + on - enable { + set BalloonHelp(enabled) 1 + } + default { + set i $w + if {[llength $args]} { + set i [uplevel 1 [namespace code "register [list $w] $args"]] + } + set b $BalloonHelp(TOPLEVEL) + if {![winfo exists $b]} { + toplevel $b + wm overrideredirect $b 1 + wm positionfrom $b program + wm withdraw $b + pack [label $b.l -highlightthickness 0 -relief raised -bd 1 \ + -background yellow] + } + if {[info exists BalloonHelp($i)]} { return $BalloonHelp($i) } + } + } +} + +;proc register {w args} { + variable BalloonHelp + set key [lindex $args 0] + while {[string match -* $key]} { + switch -- $key { + -index { + if {[catch {$w entrycget 1 -label}]} { + return -code error "widget \"$w\" does not seem to be a\ + menu, which is required for the -index switch" + } + set index [lindex $args 1] + set args [lreplace $args 0 1] + } + default { + return -code error "unknown option \"$key\": should be -index" + } + } + set key [lindex $args 0] + } + if {[llength $args] != 1} { + return -code error "wrong \# args: should be \"balloonhelp widget\ + ?-index index? message\"" + } + if {[string match {} $key]} { + clear $w + } else { + if {![winfo exists $w]} { + return -code error "bad window path name \"$w\"" + } + if {[info exists index]} { + set BalloonHelp($w,$index) $key + #bindtags $w [linsert [bindtags $w] end BalloonsMenu] + return $w,$index + } else { + set BalloonHelp($w) $key + bindtags $w [linsert [bindtags $w] end Balloons] + return $w + } + } +} + +;proc clear {{pattern .*}} { + variable BalloonHelp + foreach w [array names BalloonHelp $pattern] { + unset BalloonHelp($w) + if {[winfo exists $w]} { + set tags [bindtags $w] + if {[set i [lsearch $tags Balloons]] != -1} { + bindtags $w [lreplace $tags $i $i] + } + ## We don't remove BalloonsMenu because there + ## might be other indices that use it + } + } +} + +;proc show {w msg {i {}}} { + ## Use string match to allow that the help will be shown when + ## the pointer is in any child of the desired widget + if {![winfo exists $w] || ![string match \ + $w* [eval winfo containing [winfo pointerxy $w]]]} return + + variable BalloonHelp + global tcl_platform + set b $BalloonHelp(TOPLEVEL) + $b.l configure -text $msg + update idletasks + if {[string compare {} $i]} { + set y [expr [winfo rooty $w]+[$w yposition $i]+25] + if {($y+[winfo reqheight $b])>[winfo screenheight $w]} { + set y [expr [winfo rooty $w]+[$w yposition $i]-\ + [winfo reqheight $b]-5] + } + } else { + set y [expr [winfo rooty $w]+[winfo height $w]+5] + if {($y+[winfo reqheight $b])>[winfo screenheight $w]} { + set y [expr [winfo rooty $w]-[winfo reqheight $b]-5] + } + } + set x [expr [winfo rootx $w]+([winfo width $w]-[winfo reqwidth $b])/2] + if {$x<0} { + set x 0 + } elseif {($x+[winfo reqwidth $b])>[winfo screenwidth $w]} { + set x [expr [winfo screenwidth $w]-[winfo reqwidth $b]] + } + wm geometry $b +$x+$y + if {[string match windows $tcl_platform(platform)]} { + ## Yes, this is only needed on Windows + update idletasks + } + wm deiconify $b + raise $b +} + +;proc menuMotion {w} { + variable BalloonHelp + if {$BalloonHelp(enabled)} { + set cur [$w index active] + ## The next two lines (all uses of LAST) are necessary until the + ## <<MenuSelect>> event is properly coded for Unix/(Windows)? + if {$cur == $BalloonHelp(LAST)} return + set BalloonHelp(LAST) $cur + ## a little inlining - this is :hide + after cancel $BalloonHelp(AFTERID) + catch {wm withdraw $BalloonHelp(TOPLEVEL)} + if {[info exists BalloonHelp($w,$cur)] || \ + (![catch {$w entrycget $cur -label} cur] && \ + [info exists BalloonHelp($w,$cur)])} { + set BalloonHelp(AFTERID) [after $BalloonHelp(DELAY) \ + [namespace code [list show $w $BalloonHelp($w,$cur) $cur]]] + } + } +} + +;proc hide {args} { + variable BalloonHelp + after cancel $BalloonHelp(AFTERID) + catch {wm withdraw $BalloonHelp(TOPLEVEL)} +} + +}; # end namespace ::Widget::BalloonHelp + +namespace eval :: {namespace import -force ::Widget::BalloonHelp::balloonhelp} diff --git a/modules/tclsci/tcl/sciGUI/local_extra/combobox-2.3/ANNOUNCE.txt b/modules/tclsci/tcl/sciGUI/local_extra/combobox-2.3/ANNOUNCE.txt new file mode 100755 index 000000000..6be317995 --- /dev/null +++ b/modules/tclsci/tcl/sciGUI/local_extra/combobox-2.3/ANNOUNCE.txt @@ -0,0 +1,37 @@ +Combobox 2.3 release announcement +September 30, 2003 + +This is to announce version 2.3 of my pure Tcl combobox widget. This +version includes the following new features from version 2.2 + +* added -buttonbackground option +* added -listvar option +* tweaked packing order of internal widgets, which improves the + resize behavior a bit (thanks to Oliver Bienert for the suggestion) +* exposed "subwidget" command (eg: .combobox subwidget entry) + +Where to get it: + +You can download combobox version 2.3 from the following URL: + + http://www.purl.org/net/oakley/tcl/combobox/index.html + + +Basic features: + +* written in pure tcl; no megawidget or OO extensions required + +* platform independent, and works for all versions of tk >= 8.0 + +* self-contained and portable; all the code is in one file + +* API is similar to standard Tk widgets, with subcommands + such as configure, cget, insert, etc. + +* keyboard navigation + +* emulates the look and feel of a Windows combobox + +* completely, totally, free. I retain copyright but you are + free to use the code however you see fit. Don't be mean. + diff --git a/modules/tclsci/tcl/sciGUI/local_extra/combobox-2.3/README.txt b/modules/tclsci/tcl/sciGUI/local_extra/combobox-2.3/README.txt new file mode 100755 index 000000000..7127f1e9e --- /dev/null +++ b/modules/tclsci/tcl/sciGUI/local_extra/combobox-2.3/README.txt @@ -0,0 +1,21 @@ +Combobox version 2.3 +Copyright (c) 1998-2003, Bryan Douglas Oakley +All Rights Reserved. + +http://www.purl.org/net/oakley/tcl/combobox/index.html +mailto:oakley@bardo.clearlight.com + +This software is provided AS-IS with no waranty expressed or +implied. This software may be used free of charge, though I would +appreciate it if you give credit where credit is due and mention my +name when you use it. + +To use: place combobox.tcl where your programs can get at it either +via autoloading or from a "source" command. To create a combobox widget +use the command "::combobox::combobox", or import the combobox command +with "import ::combobox::*" to use it as simply "combobox". + +To see a quick example, start up a wish process and cd to the directory +where combobox.tcl is located. Then do "source example.tcl". + +##################################################################### diff --git a/modules/tclsci/tcl/sciGUI/local_extra/combobox-2.3/combobox.html b/modules/tclsci/tcl/sciGUI/local_extra/combobox-2.3/combobox.html new file mode 100755 index 000000000..2d270e711 --- /dev/null +++ b/modules/tclsci/tcl/sciGUI/local_extra/combobox-2.3/combobox.html @@ -0,0 +1,626 @@ +<html><head><title>combobox - </title></head> +<! -- Generated from combobox.man by tcllib/doctools/mpexpand with fmt.html --> +<! -- Copyright (c) 2003 bryan --> +<! -- All rights reserved --> +<! -- CVS: $Id: combobox.html,v 1.1 2004/06/29 08:34:56 steer Exp $ combobox.n --> + +<h1> combobox(n) 2.3 combobox ""</h1> +<a name="name"><h2>NAME</h2> +<p> combobox - Combobox Megawidget + + + + + +<a name="synopsis"><h2>SYNOPSIS</h2> +<table border=1 width=100% cellspacing=0 cellpadding=0><tr bgcolor=lightyellow><td bgcolor=lightyellow><table 0 width=100% cellspacing=0 cellpadding=0><tr valign=top ><td >package require combobox 2.3 </td></tr> +<tr valign=top ><td >combobox::combobox <i class='arg'>pathName</i> ?options? </td></tr> +</table></td></tr></table> +<a name="description"><h2>DESCRIPTION</h2> + +This package provides a new widget named &quot;combobox&quot; which combines an +entry widget and a dropdown menu into a single widget. + +<a name="standardoptions"><h2>STANDARD OPTIONS</h2> + +-background +-borderwidth +-cursor +-font +-foreground +-height +-highlightthickness +-highlightbackground +-highlightcolor +-maxheight +-relief +-selectbackground +-selectborderwidth +-selectforeground +-state +-textvariable +-xscrollcommand + +<p> + +See the options manual entry for detailed descriptions of the above options. + +<a name="widgetspecificoptions"><h2>WIDGET-SPECIFIC OPTIONS</h2> + +<dl> + +<dt>Command-Line Switch: <strong>-buttonbackground</strong><br> +Database Name: <strong>buttonBackground</strong><br> +Database Class: <strong>ButtonBackground</strong><br> +<dd> + +Defines the background color of the button used to activate the +dropdown list. + +<br><br> +<dt>Command-Line Switch: <strong>-command</strong><br> +Database Name: <strong>command</strong><br> +Database Class: <strong>Command</strong><br> +<dd> + +Defines a command to be run whenver the user selects a value from the +dropdown list box. If the combobox is editable, the command will also +be called whenever the user presses return or the widget loses the keyboard +focus and the value has changed. The command will have two values +appended to it: the name of the window and the new value of the +combobox. The value is considered to have changed if it differs from +the value when the entry first gained focus, or since the last time +the command was called. +<br><br> +It is important to note that if the combobox has an associated +<i class='arg'>-textvariable</i>, the command will not be called if the value of +the variable is changed external to the combobox. + +<br><br> +<dt>Command-Line Switch: <strong>-commandstate</strong><br> +Database Name: <strong>commandState</strong><br> +Database Class: <strong>State</strong><br> +<dd> + +One of &quot;normal&quot; or &quot;disabled&quot;. If set to &quot;disabled&quot;, the value of +the B&lt;-command&gt; option will not be evaluated when the value of the +combobox changes. + +<br><br> +<dt>Command-Line Switch: <strong>-disabledbackground</strong><br> +Database Name: <strong>disabledBackground</strong><br> +Database Class: <strong>DisabledBackground</strong><br> +<dd> + +Defines the background color for the combobox when it is disabled. + +<br><br> +<dt>Command-Line Switch: <strong>-disabledforeground</strong><br> +Database Name: <strong>disabledForeground</strong><br> +Database Class: <strong>DisabledForeground</strong><br> +<dd> + +Defines the foreground color for the combobox when it is disabled. + +<br><br> +<dt>Command-Line Switch: <strong>-dropdownwidth</strong><br> +Database Name: <strong>dropdownWidth</strong><br> +Database Class: <strong>DropdownWidth</strong><br> +<dd> + +Defines the width of the dropdown list. If null or 0, the dropdown +listbox width will be the same as the always-visible portion of the +combobox (ie: the entry and menubutton). Otherwise the value specifies +the number of average-sized characters to display in the dropdown listbox. + +<br><br> +<dt>Command-Line Switch: <strong>-editable</strong><br> +Database Name: <strong>editable</strong><br> +Database Class: <strong>Editable</strong><br> +<dd>. + +A boolean value which specifies whether the entry widget of the +combobox can be typed in. If false, values may only be set by +selecting them from the dropdown list. + +<br><br> +<dt>Command-Line Switch: <strong>-elementborderwidth</strong><br> +Database Name: <strong>elementBorderWidth</strong><br> +Database Class: <strong>BorderWidth</strong><br> +<dd> + +Specifies the width of borders drawn around the internal elements of +the widget (the button and the scrollbars for the dropdown list). + +<br><br> +<dt>Command-Line Switch: <strong>-height</strong><br> +Database Name: <strong>height</strong><br> +Database Class: <strong>Height</strong><br> +<dd> + +Specifies the hight of the dropdown list, in number of lines. A value +of zero will make the dropdown list just tall enough to hold all of +the elements in the list. The height defaults to 10. + +<br><br> +<dt>Command-Line Switch: <strong>-image</strong><br> +Database Name: <strong>image</strong><br> +Database Class: <strong>Image</strong><br> +<dd> + +Defines an image to use on the button used to drop down the list. If +it is not specified it defaults to a small black triangle. + +<br><br> +<dt>Command-Line Switch: <strong>-listvar</strong><br> +Database Name: <strong>listVariable</strong><br> +Database Class: <strong>ListVariable</strong><br> +<dd> + +Specifies the name of a variable associated with the dropdown listbox. +If the variable changes the listbox will automatically update itself +to reflect the new value. Attempts to unset a variable in use as a +listvar will fail but will not generate an error. + +<br><br> +<dt>Command-Line Switch: <strong>-maxheight</strong><br> +Database Name: <strong>maxHeight</strong><br> +Database Class: <strong>Height</strong><br> +<dd> + +Sets the maximum height of the dropdown list, in the event +B&lt;-height&gt; is set to zero and there are a large number of items in the +list. If this value is set to 0 (zero) the list will be as large as +the total number of items in the list. The maxheight defaults to 10. + +<br><br> +<dt>Command-Line Switch: <strong>-opencommand</strong><br> +Database Name: <strong>openCommand</strong><br> +Database Class: <strong>Command</strong><br> +<dd> + +If this option is specified then it provides a Tcl command to +execute each time the combobox is opened (eg: when the dropdown +listbox is displayed). The command is invoked by the B&lt;open&gt; widget +command before opening the combobox. + +<br><br> +<dt>Command-Line Switch: <strong>-value</strong><br> +Database Name: <strong>value</strong><br> +Database Class: <strong>Value</strong><br> +<dd> + +Specifies the value for the combobox. + +<br><br> +<dt>Command-Line Switch: <strong>-width</strong><br> +Database Name: <strong>width</strong><br> +Database Class: <strong>Width</strong><br> +<dd> + +Specifies an integer value indicating the desired width of the +combobox entry widget, in average size characters of the widget's +font. If the value is less than or equal to zero, the widget picks a +size large enough to hold its current text. + +</dl> + +<a name="overview"><h2>OVERVIEW</h2> + +The <b class='cmd'>combobox</b> command creates a new window (given by the +<i class='arg'>pathName</i> argument) and makes it into a dropdown combobox +widget. Additional options, described above, may be specified on the +command line. Currently no option database support is provided. The +<b class='cmd'>combobox</b> command returns its <em>pathName</em> arguument. At +the time this command is invoked, there must not exists a window named +<em>pathName</em>, but <em>pathName's</em> parent must exist. + +<p> + +A combobox is a widget that displays a one-line text string, and +allows that string to be edited or selected from a dropdown list. When +first created a combobox's value is the null string unless a variable +is associated with the widget using the <i class='arg'>-textvariable</i> option, in +which case it will be the value stored in the associated variable. + +<p> + +The combobox entry wiget is capable of displaying strings that are too +long to fit entirely within the widget's window. In this case only a +portion of the string will be displayed; commands described below may +be used to change the view in the window. Comboboxes use the standard +-xscrollcommand mechanism for interacting with scrollbars (see +the description of the -xscrollcommand option for +details). They also support scanning, as described below. + +<a name="widgetcommand"><h2>WIDGET COMMAND</h2> + +The <b class='cmd'>combobox</b> command creates a new Tcl command whose name is +<i class='arg'>pathName</i>. This command may be used to invoke various operations on +the widget. It has the following general form: + +<p><table><tr><td bgcolor=black> </td><td><pre class='sample'> + <i class='arg'>pathName</i> option ?arg arg ...? +</pre></td></tr></table></p> + +<em>option</em> and the <em>arg</em>s determine the exact behavior of the command. + +<p> + +Many of the widget commands take one or more indicies as +arguments. For <strong>list</strong> commands the indicies may take one of the forms +acceptable to the standard listbox command. For all other commands +the indicies may take the form of an indicie for a standard entry +widget. See the appropriate man pages for more information. + +<p> + +The following commands are possible for combobox widgets: + +<p> + +<dl> + +<dt><i class='arg'>pathName</i> <strong>bbox</strong> <em>index</em><dd> + +Returns a list of four numbers describing the bounding box of the +characters given by <em>index</em>. The first two elements of the list give +the x and y coordinates of the upper-left corner of the screen area +covered by the character (in pixels relative to the widget) and the +last two elements give the width and height of the character, in +pixels. The bounding box may refer to a region outside the visible +area of the window. + +<br><br> +<dt><i class='arg'>pathName</i> <strong>cget</strong> <em>option</em><dd> + +Returns the current value for the configuration option give +by <em>option</em>. <em>Option</em> may have any of the values accepted by +the <b class='cmd'>combobox</b> command. + +<br><br> +<dt><i class='arg'>pathName</i> <strong>close</strong><dd> + +Causes the dropdown listbox of the widget to be withdrawn if it is +currently displayed. + +<br><br> +<dt><i class='arg'>pathName</i> <strong>configure</strong> <em>option</em><dd> + +Query or modify the configuration options of the widget. If no option +is specified, returns a list describing all of the available options +for pathName, though not in the same format as describe in +Tk_ConfigureInfo. The format will be a list, where each element will +be a list of two values: an option name and the current value. + +<br><br> + +If <em>option</em> is specified with no value, then the command +returns a list describing the one named <em>option</em>. This list will be +identical to the corresponding sublist of the value returned if no +<em>option</em> is specified. If one or more option-value pairs are +specified, then the command modifies the given widget <em>option</em>(s) to +have the given value(s); in this case the command returns an empty +string. <em>Option</em> may have any of the values accepted by the entry +command. + +<br><br> +<dt><i class='arg'>pathName</i> <strong>curselection</strong><dd> + +Returns the index of the dropdown list item that matches the value +of the combobox, or -1 if the combobox is editable and the string +doesn't match a value in the list. + +<br><br> +<dt><i class='arg'>pathName</i> <strong>delete</strong> <em>first</em> ?last?<dd> + +Delete one or more elements from the combobox entry widget. <em>First</em> +is the index of the first character to delete, and <em>last</em> is the index +of the character just after the last one to delete. If <em>last</em> isn't +specified it defaults to <em>first</em>+1, i.e. a single character is +deleted. This command returns an empty string. + +<br><br> +<dt><i class='arg'>pathName</i> <strong>get</strong><dd> + +Returns the combobox's string. + +<br><br> +<dt><i class='arg'>pathName</i> <strong>icursor</strong> <em>index</em><dd> + +Arrange for the insertion cursor to be displayed just before the +character given by <em>index</em>. Returns an empty string. + +<br><br> +<dt><i class='arg'>pathName</i> <strong>index</strong> <em>index</em><dd> + +Returns the numerical index corresponding to <em>index</em> + +<br><br> +<dt><i class='arg'>pathName</i> <strong>insert</strong> <em>index</em> <em>string</em><dd> + +Insert the characters of <em>string</em> just before the character indicated +by <em>index</em>. Returns an empty string. + +<br><br> +<dt><i class='arg'>pathName</i> <strong>list</strong> <em>option</em> <em>args</em><dd> + +This command is used to manipulate the items in the dropdown +list. It has several forms, depending on <em>option</em>: + +<br><br> +<dl> + +<dt><strong>list</strong> <strong>delete</strong> <em>first</em> ?last?<dd> + +Deletes one or more elements of the dropdown list. First and last are +indices specifying the first and last elements in the range to delete. +If last isn't specified it defaults to first, i.e. a single element is +deleted. + +<br><br> +<dt><strong>list</strong> <strong>get</strong> <em>first</em> ?last?<dd> + +If last is omitted, returns the contents of the dropdown list element +indicated by first, or an empty string if first refers to a +non-existent element. If last is specified, the command returns a list +whose elements are all of the dropdown list elements between first and last, +inclusive. Both first and last may have any of the standard forms for +indices. + +<br><br> +<dt><strong>list</strong> <strong>index</strong> <em>index</em><dd> + +Returns the integer index value that corresponds to index. If index is +end the return value is a count of the number of elements in the +dropdown list (not the index of the last element). + +<br><br> +<dt><strong>list</strong> <strong>insert</strong> <em>index</em> ?element element ...?<dd> + +Inserts zero or more new elements in the list just before the element +given by index. If index is specified as end then the new elements +are added to the end of the list. Returns an empty string. + +<br><br> +<dt><strong>list</strong> <strong>size</strong><dd> + +Returns a decimal string indicating the total number of elements in +the dropdown list. <br><br> + +</dl> + +<dt><i class='arg'>pathName</i> <strong>open</strong><dd> + +Causes the dropdown listbox of the combobox to be displayed if it +is currently hidden. + +<br><br> +<dt><i class='arg'>pathName</i> <strong>scan</strong> <em>option</em> <em>args</em><dd> + +This command is used to implement scanning on the combobox entry +widget. It has two forms, depending on option: + +<br><br> +<dl> + +<dt><i class='arg'>pathName</i> <strong>scan mark</strong> <em>x</em><dd> + +Records x and the current view in the entry window; used in +conjunction with later <strong>scan dragto</strong> commands. Typically this +command is associated with a mouse button press in the widget. It +returns an empty string. + +<br><br> +<dt><i class='arg'>pathName</i> <strong>scan dragto</strong> <em>x</em><dd> + +This command computes the difference between its <em>x</em> argument +and the <em>x</em> argument to the last <strong>scan mark</strong> command +for the widget. It then adjusts the view left or right by 10 times +the difference in x-coordinates. This command is typically associated +with mouse motion events in the widget, to produce the effect of +dragging the entry at high speed through the window. The return +value is an empty string. <br><br> + +</dl> + +<dt><i class='arg'>pathName</i> <strong>select</strong> <em>index</em><dd> + +Selects the item in the dropdown list represented by <em>index</em> and +makes that the current value of the combobox. + +<br><br> +<dt><i class='arg'>pathName</i> <strong>selection</strong> <em>option</em> <em>arg</em><dd> + +This command is used to adjus the selection within the editable +portion of the combobox. It has several forms, depending on +<em>option</em>: + +<br><br> +<dl> + +<dt><i class='arg'>pathName</i> <strong>selection</strong> <strong>adjust</strong> <i class='arg'>index</i><dd> + +Locate the end of the selection nearest to the character given by +<i class='arg'>idnex</i> (i.e. including but not going beyond <i class='arg'>index</i>). The +other end of the selection is made the anchor point for future +<strong>select to</strong> commands. If the selection isn't currently in +the editable portion of the combobox, then a new selection is created +to include the characters between <i class='arg'>index</i> and the most recent +selection anchor point, inclusive. Returns an empty string. + +<br><br> +<dt><i class='arg'>pathName</i> <strong>selection</strong> <strong>clear</strong><dd> + +Clear the selection if it is currently in this widget. If the +selection isn't in this widget then the command has no +effect. Returns an empty string. + +<br><br> +<dt><i class='arg'>pathname</i> <strong>selection</strong> <strong>from</strong> <i class='arg'>index</i><dd> + +Set the selection anchor point to just before the character given by +<i class='arg'>index</i>. Doesn't change the selection. Returns an empty string. + +<br><br> +<dt><i class='arg'>pathname</i> <strong>selection</strong> <strong>parent</strong><dd> + +Returns 1 if there are characters selected in the editable portion of +the combobox, otherwise it returns 0. + +<br><br> +<dt><i class='arg'>pathname</i> <strong>selection</strong> <strong>range</strong> <i class='arg'>start</i> <i class='arg'>end</i><dd> + +Sets the selection to include the characters starting with the one +indexed by <i class='arg'>start</i> and ending with the one just before <i class='arg'>end</i>. +If <i class='arg'>end</i> refers to the same character as <i class='arg'>start</i> or an +earlier one, then the selection is cleared. + +<br><br> +<dt><i class='arg'>pathname</i> <strong>selection</strong> <strong>to</strong> <i class='arg'>index</i><dd> + +If <i class='arg'>index</i> is before the anchor point, set the selection to the +characters from <i class='arg'>index</i> up to but not including the anchor +point. If <i class='arg'>index</i> is the same as the anchor point, do nothing. If +<i class='arg'>index</i> is after the anchor point, set the selection to the +characters from the anchor point up to but not including <i class='arg'>index</i>. +The anchor point is determined by the most recent <strong>select from</strong> +or <strong>select adjust</strong> command in this widget. If the selection +isn't in this widget then a new selection is created using the most +recent anchor point specified for the widget. Returns an empty string. +<br><br> + +</dl> + +<dt><i class='arg'>pathName</i> <strong>subwidget</strong> ?name?<dd> + +This command returns a list of internal widget names if given no +arguments, or returns the internal widget path for the widget identified +by <em>name</em>. + +<br><br> +<dt><i class='arg'>pathName</i> <strong>xview</strong> <em>args</em><dd> + +This command is used to query and change the horizontal position of +the text in the widget's window. It can take any of the following +forms: + +<br><br> +<dl> + +<dt><i class='arg'>pathName</i> <strong>xview</strong><dd> + +Returns a list containing two elements. Each element is a real +fraction between 0 and 1; together they describe the horizontal span +that is visible in the window. For example, if the first element is .2 +and the second element is .6, 20% of the entry's text is off-screen to +the left, the middle 40% is visible in the window, and 40% of the text +is off-screen to the right. These are the same values passed to +scrollbars via the <i class='arg'>-xscrollcommand</i> option. + +<br><br> +<dt><i class='arg'>pathName</i> <strong>xview</strong> <em>index</em><dd> + +Adjusts the view in the window so that the character given by <em>index</em> is +displayed at the left edge of the window. + +<br><br> +<dt><i class='arg'>pathName</i> <strong>xview</strong> <strong>moveto</strong> <em>fraction</em><dd> + +Adjusts the view in the window so that the character <em>fraction</em> of the +way through the text appears at the left edge of the window. <em>Fraction</em> +must be a fraction between 0 and 1. + +<br><br> +<dt><i class='arg'>pathName</i> <strong>xview</strong> <strong>scroll</strong> <em>number</em><dd> +<em>what</em> + +This command shifts the view in the window left or right according to +<em>number</em> and <em>what</em>. <em>Number</em> must be an integer. +<em>What</em> must be +either units or pages or an abbreviation of one of these. If <em>what</em> +is units, the view adjusts left or right by number average-width +characters on the display; if it is pages then the view adjusts by +number screenfuls. If <em>number</em> is negative then characters farther to +the left become visible; if it is positive then characters farther to +the right become visible. + +</dl> + +</dl> + +<a name="defaultbindings"><h2> DEFAULT BINDINGS</h2> + +Bindings in the entry widget of the combobox are the same as for +normal entry widgets, with the following exceptions: + +<p> + +Double-clicking mouse button 1 over the entry widget will display the +dropdown list if it is not displayed, and hide it if it is. The value +of the combobox won't change. + +<p> + +If <i class='arg'>-editable</i> is set to false, single-clicking mouse button 1 +over the entry widget will display the dropdown list if it is not +displayed, and hide it if it is. The value of the combobox won't change. + +<p> + +Pressing the Up, Down, Next and Prior buttons (up arrow, down arrow, +page up and page down, respectively) will display the dropdown list if +it is not displayed. If it is displayed, these buttons will change the +current selection on the list. + +<p> + +If <i class='arg'>-editable</i> is true, pressing the Return or Tab key will set the +value to the string in the entry widget. If the list is +displayed and an item is selected, Return will set the value of the +combobox to the selected item. + +<p> + +If <i class='arg'>-editable</i> is false, pressing the Return key when the list is +displayed will result in the value of the combobox changing to the +currently highlighted item in the list. The list will be closed. + +<p> + +Pressing the escape key when the list is displayed will result in the +list being closed with the value of the combobox remaining unchanged. + +<p> + +Clicking the mouse button over an element in the dropdown list will +cause the clicked-on item to be the new value of the combobox, and the +list will be closed. + +<p> + +If the combobox is disabled using the <i class='arg'>-state</i> option, then the entry +widget's view can still be adjusted and text in the entry can be +selected, but no insertion cursor will be displayed, no text +modification will be possible, and the list cannot be displayed. + +<a name="bugs"><h2>BUGS</h2> + +With some window managers it may be possible to move the window that +contains the combobox while the dropdown list is visible. In such a +case the dropdown list will stay where it originally appeared. Well +behaved window managers shouldn't let you move the window while the +list is displayed. + +<p> + +It has been reported that with some virtual window managers, switching +to a new virtual window while the dropdown list is visible will result +in the dropdown list appearing by itself in the new virtual window. + +<p> + +So the lesson here is: don't dork with your windows while the dropdown +list is visible. That, or get a better window manager. + +</body></html> diff --git a/modules/tclsci/tcl/sciGUI/local_extra/combobox-2.3/combobox.tcl b/modules/tclsci/tcl/sciGUI/local_extra/combobox-2.3/combobox.tcl new file mode 100755 index 000000000..2328312b8 --- /dev/null +++ b/modules/tclsci/tcl/sciGUI/local_extra/combobox-2.3/combobox.tcl @@ -0,0 +1,2188 @@ +# Copyright (c) 1998-2003, Bryan Oakley +# All Rights Reservered +# +# Bryan Oakley +# oakley@bardo.clearlight.com +# +# combobox v2.3 August 16, 2003 +# +# a combobox / dropdown listbox (pick your favorite name) widget +# written in pure tcl +# +# this code is freely distributable without restriction, but is +# provided as-is with no warranty expressed or implied. +# +# thanks to the following people who provided beta test support or +# patches to the code (in no particular order): +# +# Scott Beasley Alexandre Ferrieux Todd Helfter +# Matt Gushee Laurent Duperval John Jackson +# Fred Rapp Christopher Nelson +# Eric Galluzzo Jean-Francois Moine Oliver Bienert +# +# A special thanks to Martin M. Hunt who provided several good ideas, +# and always with a patch to implement them. Jean-Francois Moine, +# Todd Helfter and John Jackson were also kind enough to send in some +# code patches. +# +# ... and many others over the years. + +package require Tk 8.0 +package provide combobox 2.3 + +namespace eval ::combobox { + + # this is the public interface + namespace export combobox + + # these contain references to available options + variable widgetOptions + + # these contain references to available commands and subcommands + variable widgetCommands + variable scanCommands + variable listCommands +} + +# ::combobox::combobox -- +# +# This is the command that gets exported. It creates a new +# combobox widget. +# +# Arguments: +# +# w path of new widget to create +# args additional option/value pairs (eg: -background white, etc.) +# +# Results: +# +# It creates the widget and sets up all of the default bindings +# +# Returns: +# +# The name of the newly create widget + +proc ::combobox::combobox {w args} { + variable widgetOptions + variable widgetCommands + variable scanCommands + variable listCommands + + # perform a one time initialization + if {![info exists widgetOptions]} { + Init + } + + # build it... + eval Build $w $args + + # set some bindings... + SetBindings $w + + # and we are done! + return $w +} + + +# ::combobox::Init -- +# +# Initialize the namespace variables. This should only be called +# once, immediately prior to creating the first instance of the +# widget +# +# Arguments: +# +# none +# +# Results: +# +# All state variables are set to their default values; all of +# the option database entries will exist. +# +# Returns: +# +# empty string + +proc ::combobox::Init {} { + variable widgetOptions + variable widgetCommands + variable scanCommands + variable listCommands + variable defaultEntryCursor + + array set widgetOptions [list \ + -background {background Background} \ + -bd -borderwidth \ + -bg -background \ + -borderwidth {borderWidth BorderWidth} \ + -buttonbackground {buttonBackground Background} \ + -command {command Command} \ + -commandstate {commandState State} \ + -cursor {cursor Cursor} \ + -disabledbackground {disabledBackground DisabledBackground} \ + -disabledforeground {disabledForeground DisabledForeground} \ + -dropdownwidth {dropdownWidth DropdownWidth} \ + -editable {editable Editable} \ + -elementborderwidth {elementBorderWidth BorderWidth} \ + -fg -foreground \ + -font {font Font} \ + -foreground {foreground Foreground} \ + -height {height Height} \ + -highlightbackground {highlightBackground HighlightBackground} \ + -highlightcolor {highlightColor HighlightColor} \ + -highlightthickness {highlightThickness HighlightThickness} \ + -image {image Image} \ + -listvar {listVariable Variable} \ + -maxheight {maxHeight Height} \ + -opencommand {opencommand Command} \ + -relief {relief Relief} \ + -selectbackground {selectBackground Foreground} \ + -selectborderwidth {selectBorderWidth BorderWidth} \ + -selectforeground {selectForeground Background} \ + -state {state State} \ + -takefocus {takeFocus TakeFocus} \ + -textvariable {textVariable Variable} \ + -value {value Value} \ + -width {width Width} \ + -xscrollcommand {xScrollCommand ScrollCommand} \ + ] + + + set widgetCommands [list \ + bbox cget configure curselection \ + delete get icursor index \ + insert list scan selection \ + xview select toggle open \ + close subwidget \ + ] + + set listCommands [list \ + delete get \ + index insert size \ + ] + + set scanCommands [list mark dragto] + + # why check for the Tk package? This lets us be sourced into + # an interpreter that doesn't have Tk loaded, such as the slave + # interpreter used by pkg_mkIndex. In theory it should have no + # side effects when run + if {[lsearch -exact [package names] "Tk"] != -1} { + + ################################################################## + #- this initializes the option database. Kinda gross, but it works + #- (I think). + ################################################################## + + # the image used for the button... + if {$::tcl_platform(platform) == "windows"} { + image create bitmap ::combobox::bimage -data { + #define down_arrow_width 12 + #define down_arrow_height 12 + static char down_arrow_bits[] = { + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xfc,0xf1,0xf8,0xf0,0x70,0xf0,0x20,0xf0, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00; + } + } + } else { + image create bitmap ::combobox::bimage -data { + #define down_arrow_width 15 + #define down_arrow_height 15 + static char down_arrow_bits[] = { + 0x00,0x80,0x00,0x80,0x00,0x80,0x00,0x80, + 0x00,0x80,0xf8,0x8f,0xf0,0x87,0xe0,0x83, + 0xc0,0x81,0x80,0x80,0x00,0x80,0x00,0x80, + 0x00,0x80,0x00,0x80,0x00,0x80 + } + } + } + + # compute a widget name we can use to create a temporary widget + set tmpWidget ".__tmp__" + set count 0 + while {[winfo exists $tmpWidget] == 1} { + set tmpWidget ".__tmp__$count" + incr count + } + + # get the scrollbar width. Because we try to be clever and draw our + # own button instead of using a tk widget, we need to know what size + # button to create. This little hack tells us the width of a scroll + # bar. + # + # NB: we need to be sure and pick a window that doesn't already + # exist... + scrollbar $tmpWidget + set sb_width [winfo reqwidth $tmpWidget] + set bbg [$tmpWidget cget -background] + destroy $tmpWidget + + # steal options from the entry widget + # we want darn near all options, so we'll go ahead and do + # them all. No harm done in adding the one or two that we + # don't use. + entry $tmpWidget + foreach foo [$tmpWidget configure] { + # the cursor option is special, so we'll save it in + # a special way + if {[lindex $foo 0] == "-cursor"} { + set defaultEntryCursor [lindex $foo 4] + } + if {[llength $foo] == 5} { + set option [lindex $foo 1] + set value [lindex $foo 4] + option add *Combobox.$option $value widgetDefault + + # these options also apply to the dropdown listbox + if {[string compare $option "foreground"] == 0 \ + || [string compare $option "background"] == 0 \ + || [string compare $option "font"] == 0} { + option add *Combobox*ComboboxListbox.$option $value \ + widgetDefault + } + } + } + destroy $tmpWidget + + # these are unique to us... + option add *Combobox.elementBorderWidth 1 widgetDefault + option add *Combobox.buttonBackground $bbg widgetDefault + option add *Combobox.dropdownWidth {} widgetDefault + option add *Combobox.openCommand {} widgetDefault + option add *Combobox.cursor {} widgetDefault + option add *Combobox.commandState normal widgetDefault + option add *Combobox.editable 1 widgetDefault + option add *Combobox.maxHeight 10 widgetDefault + option add *Combobox.height 0 + } + + # set class bindings + SetClassBindings +} + +# ::combobox::SetClassBindings -- +# +# Sets up the default bindings for the widget class +# +# this proc exists since it's The Right Thing To Do, but +# I haven't had the time to figure out how to do all the +# binding stuff on a class level. The main problem is that +# the entry widget must have focus for the insertion cursor +# to be visible. So, I either have to have the entry widget +# have the Combobox bindtag, or do some fancy juggling of +# events or some such. What a pain. +# +# Arguments: +# +# none +# +# Returns: +# +# empty string + +proc ::combobox::SetClassBindings {} { + + # make sure we clean up after ourselves... + bind Combobox <Destroy> [list ::combobox::DestroyHandler %W] + + # this will (hopefully) close (and lose the grab on) the + # listbox if the user clicks anywhere outside of it. Note + # that on Windows, you can click on some other app and + # the listbox will still be there, because tcl won't see + # that button click + set this {[::combobox::convert %W -W]} + bind Combobox <Any-ButtonPress> "$this close" + bind Combobox <Any-ButtonRelease> "$this close" + + # this helps (but doesn't fully solve) focus issues. The general + # idea is, whenever the frame gets focus it gets passed on to + # the entry widget + bind Combobox <FocusIn> {::combobox::tkTabToWindow \ + [::combobox::convert %W -W].entry} + + # this closes the listbox if we get hidden + bind Combobox <Unmap> {[::combobox::convert %W -W] close} + + return "" +} + +# ::combobox::SetBindings -- +# +# here's where we do most of the binding foo. I think there's probably +# a few bindings I ought to add that I just haven't thought +# about... +# +# I'm not convinced these are the proper bindings. Ideally all +# bindings should be on "Combobox", but because of my juggling of +# bindtags I'm not convinced thats what I want to do. But, it all +# seems to work, its just not as robust as it could be. +# +# Arguments: +# +# w widget pathname +# +# Returns: +# +# empty string + +proc ::combobox::SetBindings {w} { + upvar ::combobox::${w}::widgets widgets + upvar ::combobox::${w}::options options + + # juggle the bindtags. The basic idea here is to associate the + # widget name with the entry widget, so if a user does a bind + # on the combobox it will get handled properly since it is + # the entry widget that has keyboard focus. + bindtags $widgets(entry) \ + [concat $widgets(this) [bindtags $widgets(entry)]] + + bindtags $widgets(button) \ + [concat $widgets(this) [bindtags $widgets(button)]] + + # override the default bindings for tab and shift-tab. The + # focus procs take a widget as their only parameter and we + # want to make sure the right window gets used (for shift- + # tab we want it to appear as if the event was generated + # on the frame rather than the entry. + bind $widgets(entry) <Tab> \ + "::combobox::tkTabToWindow \[tk_focusNext $widgets(entry)\]; break" + bind $widgets(entry) <Shift-Tab> \ + "::combobox::tkTabToWindow \[tk_focusPrev $widgets(this)\]; break" + + # this makes our "button" (which is actually a label) + # do the right thing + bind $widgets(button) <ButtonPress-1> [list $widgets(this) toggle] + + # this lets the autoscan of the listbox work, even if they + # move the cursor over the entry widget. + bind $widgets(entry) <B1-Enter> "break" + + bind $widgets(listbox) <ButtonRelease-1> \ + "::combobox::Select [list $widgets(this)] \ + \[$widgets(listbox) nearest %y\]; break" + + bind $widgets(vsb) <ButtonPress-1> {continue} + bind $widgets(vsb) <ButtonRelease-1> {continue} + + bind $widgets(listbox) <Any-Motion> { + %W selection clear 0 end + %W activate @%x,%y + %W selection anchor @%x,%y + %W selection set @%x,%y @%x,%y + # need to do a yview if the cursor goes off the top + # or bottom of the window... (or do we?) + } + + # these events need to be passed from the entry widget + # to the listbox, or otherwise need some sort of special + # handling. + foreach event [list <Up> <Down> <Tab> <Return> <Escape> \ + <Next> <Prior> <Double-1> <1> <Any-KeyPress> \ + <FocusIn> <FocusOut>] { + bind $widgets(entry) $event \ + [list ::combobox::HandleEvent $widgets(this) $event] + } + + # like the other events, <MouseWheel> needs to be passed from + # the entry widget to the listbox. However, in this case we + # need to add an additional parameter + catch { + bind $widgets(entry) <MouseWheel> \ + [list ::combobox::HandleEvent $widgets(this) <MouseWheel> %D] + } +} + +# ::combobox::Build -- +# +# This does all of the work necessary to create the basic +# combobox. +# +# Arguments: +# +# w widget name +# args additional option/value pairs +# +# Results: +# +# Creates a new widget with the given name. Also creates a new +# namespace patterened after the widget name, as a child namespace +# to ::combobox +# +# Returns: +# +# the name of the widget + +proc ::combobox::Build {w args } { + variable widgetOptions + + if {[winfo exists $w]} { + error "window name \"$w\" already exists" + } + + # create the namespace for this instance, and define a few + # variables + namespace eval ::combobox::$w { + + variable ignoreTrace 0 + variable oldFocus {} + variable oldGrab {} + variable oldValue {} + variable options + variable this + variable widgets + + set widgets(foo) foo ;# coerce into an array + set options(foo) foo ;# coerce into an array + + unset widgets(foo) + unset options(foo) + } + + # import the widgets and options arrays into this proc so + # we don't have to use fully qualified names, which is a + # pain. + upvar ::combobox::${w}::widgets widgets + upvar ::combobox::${w}::options options + + # this is our widget -- a frame of class Combobox. Naturally, + # it will contain other widgets. We create it here because + # we need it in order to set some default options. + set widgets(this) [frame $w -class Combobox -takefocus 0] + set widgets(entry) [entry $w.entry -takefocus 1] + set widgets(button) [label $w.button -takefocus 0] + + # this defines all of the default options. We get the + # values from the option database. Note that if an array + # value is a list of length one it is an alias to another + # option, so we just ignore it + foreach name [array names widgetOptions] { + if {[llength $widgetOptions($name)] == 1} continue + + set optName [lindex $widgetOptions($name) 0] + set optClass [lindex $widgetOptions($name) 1] + + set value [option get $w $optName $optClass] + set options($name) $value + } + + # a couple options aren't available in earlier versions of + # tcl, so we'll set them to sane values. For that matter, if + # they exist but are empty, set them to sane values. + if {[string length $options(-disabledforeground)] == 0} { + set options(-disabledforeground) $options(-foreground) + } + if {[string length $options(-disabledbackground)] == 0} { + set options(-disabledbackground) $options(-background) + } + + # if -value is set to null, we'll remove it from our + # local array. The assumption is, if the user sets it from + # the option database, they will set it to something other + # than null (since it's impossible to determine the difference + # between a null value and no value at all). + if {[info exists options(-value)] \ + && [string length $options(-value)] == 0} { + unset options(-value) + } + + # we will later rename the frame's widget proc to be our + # own custom widget proc. We need to keep track of this + # new name, so we'll define and store it here... + set widgets(frame) ::combobox::${w}::$w + + # gotta do this sooner or later. Might as well do it now + pack $widgets(button) -side right -fill y -expand no + pack $widgets(entry) -side left -fill both -expand yes + + # I should probably do this in a catch, but for now it's + # good enough... What it does, obviously, is put all of + # the option/values pairs into an array. Make them easier + # to handle later on... + array set options $args + + # now, the dropdown list... the same renaming nonsense + # must go on here as well... + set widgets(dropdown) [toplevel $w.top] + set widgets(listbox) [listbox $w.top.list] + set widgets(vsb) [scrollbar $w.top.vsb] + + pack $widgets(listbox) -side left -fill both -expand y + + # fine tune the widgets based on the options (and a few + # arbitrary values...) + + # NB: we are going to use the frame to handle the relief + # of the widget as a whole, so the entry widget will be + # flat. This makes the button which drops down the list + # to appear "inside" the entry widget. + + $widgets(vsb) configure \ + -borderwidth 1 \ + -command "$widgets(listbox) yview" \ + -highlightthickness 0 + + $widgets(button) configure \ + -background $options(-buttonbackground) \ + -highlightthickness 0 \ + -borderwidth $options(-elementborderwidth) \ + -relief raised \ + -width [expr {[winfo reqwidth $widgets(vsb)] - 2}] + + $widgets(entry) configure \ + -borderwidth 0 \ + -relief flat \ + -highlightthickness 0 + + $widgets(dropdown) configure \ + -borderwidth $options(-elementborderwidth) \ + -relief sunken + + $widgets(listbox) configure \ + -selectmode browse \ + -background [$widgets(entry) cget -bg] \ + -yscrollcommand "$widgets(vsb) set" \ + -exportselection false \ + -borderwidth 0 + + +# trace variable ::combobox::${w}::entryTextVariable w \ +# [list ::combobox::EntryTrace $w] + + # do some window management foo on the dropdown window + wm overrideredirect $widgets(dropdown) 1 + wm transient $widgets(dropdown) [winfo toplevel $w] + wm group $widgets(dropdown) [winfo parent $w] + wm resizable $widgets(dropdown) 0 0 + wm withdraw $widgets(dropdown) + + # this moves the original frame widget proc into our + # namespace and gives it a handy name + rename ::$w $widgets(frame) + + # now, create our widget proc. Obviously (?) it goes in + # the global namespace. All combobox widgets will actually + # share the same widget proc to cut down on the amount of + # bloat. + proc ::$w {command args} \ + "eval ::combobox::WidgetProc $w \$command \$args" + + + # ok, the thing exists... let's do a bit more configuration. + if {[catch "::combobox::Configure [list $widgets(this)] [array get options]" error]} { + catch {destroy $w} + error "internal error: $error" + } + + return "" + +} + +# ::combobox::HandleEvent -- +# +# this proc handles events from the entry widget that we want +# handled specially (typically, to allow navigation of the list +# even though the focus is in the entry widget) +# +# Arguments: +# +# w widget pathname +# event a string representing the event (not necessarily an +# actual event) +# args additional arguments required by particular events + +proc ::combobox::HandleEvent {w event args} { + upvar ::combobox::${w}::widgets widgets + upvar ::combobox::${w}::options options + upvar ::combobox::${w}::oldValue oldValue + + # for all of these events, if we have a special action we'll + # do that and do a "return -code break" to keep additional + # bindings from firing. Otherwise we'll let the event fall + # on through. + switch $event { + + "<MouseWheel>" { + if {[winfo ismapped $widgets(dropdown)]} { + set D [lindex $args 0] + # the '120' number in the following expression has + # it's genesis in the tk bind manpage, which suggests + # that the smallest value of %D for mousewheel events + # will be 120. The intent is to scroll one line at a time. + $widgets(listbox) yview scroll [expr {-($D/120)}] units + } + } + + "<Any-KeyPress>" { + # if the widget is editable, clear the selection. + # this makes it more obvious what will happen if the + # user presses <Return> (and helps our code know what + # to do if the user presses return) + if {$options(-editable)} { + $widgets(listbox) see 0 + $widgets(listbox) selection clear 0 end + $widgets(listbox) selection anchor 0 + $widgets(listbox) activate 0 + } + } + + "<FocusIn>" { + set oldValue [$widgets(entry) get] + } + + "<FocusOut>" { + if {![winfo ismapped $widgets(dropdown)]} { + # did the value change? + set newValue [$widgets(entry) get] + if {$oldValue != $newValue} { + CallCommand $widgets(this) $newValue + } + } + } + + "<1>" { + set editable [::combobox::GetBoolean $options(-editable)] + if {!$editable} { + if {[winfo ismapped $widgets(dropdown)]} { + $widgets(this) close + return -code break; + + } else { + if {$options(-state) != "disabled"} { + $widgets(this) open + return -code break; + } + } + } + } + + "<Double-1>" { + if {$options(-state) != "disabled"} { + $widgets(this) toggle + return -code break; + } + } + + "<Tab>" { + if {[winfo ismapped $widgets(dropdown)]} { + ::combobox::Find $widgets(this) 0 + return -code break; + } else { + ::combobox::SetValue $widgets(this) [$widgets(this) get] + } + } + + "<Escape>" { +# $widgets(entry) delete 0 end +# $widgets(entry) insert 0 $oldValue + if {[winfo ismapped $widgets(dropdown)]} { + $widgets(this) close + return -code break; + } + } + + "<Return>" { + # did the value change? + set newValue [$widgets(entry) get] + if {$oldValue != $newValue} { + CallCommand $widgets(this) $newValue + } + + if {[winfo ismapped $widgets(dropdown)]} { + ::combobox::Select $widgets(this) \ + [$widgets(listbox) curselection] + return -code break; + } + + } + + "<Next>" { + $widgets(listbox) yview scroll 1 pages + set index [$widgets(listbox) index @0,0] + $widgets(listbox) see $index + $widgets(listbox) activate $index + $widgets(listbox) selection clear 0 end + $widgets(listbox) selection anchor $index + $widgets(listbox) selection set $index + + } + + "<Prior>" { + $widgets(listbox) yview scroll -1 pages + set index [$widgets(listbox) index @0,0] + $widgets(listbox) activate $index + $widgets(listbox) see $index + $widgets(listbox) selection clear 0 end + $widgets(listbox) selection anchor $index + $widgets(listbox) selection set $index + } + + "<Down>" { + if {[winfo ismapped $widgets(dropdown)]} { + ::combobox::tkListboxUpDown $widgets(listbox) 1 + return -code break; + + } else { + if {$options(-state) != "disabled"} { + $widgets(this) open + return -code break; + } + } + } + "<Up>" { + if {[winfo ismapped $widgets(dropdown)]} { + ::combobox::tkListboxUpDown $widgets(listbox) -1 + return -code break; + + } else { + if {$options(-state) != "disabled"} { + $widgets(this) open + return -code break; + } + } + } + } + + return "" +} + +# ::combobox::DestroyHandler {w} -- +# +# Cleans up after a combobox widget is destroyed +# +# Arguments: +# +# w widget pathname +# +# Results: +# +# The namespace that was created for the widget is deleted, +# and the widget proc is removed. + +proc ::combobox::DestroyHandler {w} { + + catch { + # if the widget actually being destroyed is of class Combobox, + # remove the namespace and associated proc. + if {[string compare [winfo class $w] "Combobox"] == 0} { + # delete the namespace and the proc which represents + # our widget + namespace delete ::combobox::$w + rename $w {} + } + } + return "" +} + +# ::combobox::Find +# +# finds something in the listbox that matches the pattern in the +# entry widget and selects it +# +# N.B. I'm not convinced this is working the way it ought to. It +# works, but is the behavior what is expected? I've also got a gut +# feeling that there's a better way to do this, but I'm too lazy to +# figure it out... +# +# Arguments: +# +# w widget pathname +# exact boolean; if true an exact match is desired +# +# Returns: +# +# Empty string + +proc ::combobox::Find {w {exact 0}} { + upvar ::combobox::${w}::widgets widgets + upvar ::combobox::${w}::options options + + ## *sigh* this logic is rather gross and convoluted. Surely + ## there is a more simple, straight-forward way to implement + ## all this. As the saying goes, I lack the time to make it + ## shorter... + + # use what is already in the entry widget as a pattern + set pattern [$widgets(entry) get] + + if {[string length $pattern] == 0} { + # clear the current selection + $widgets(listbox) see 0 + $widgets(listbox) selection clear 0 end + $widgets(listbox) selection anchor 0 + $widgets(listbox) activate 0 + return + } + + # we're going to be searching this list... + set list [$widgets(listbox) get 0 end] + + # if we are doing an exact match, try to find, + # well, an exact match + set exactMatch -1 + if {$exact} { + set exactMatch [lsearch -exact $list $pattern] + } + + # search for it. We'll try to be clever and not only + # search for a match for what they typed, but a match for + # something close to what they typed. We'll keep removing one + # character at a time from the pattern until we find a match + # of some sort. + set index -1 + while {$index == -1 && [string length $pattern]} { + set index [lsearch -glob $list "$pattern*"] + if {$index == -1} { + regsub {.$} $pattern {} pattern + } + } + + # this is the item that most closely matches... + set thisItem [lindex $list $index] + + # did we find a match? If so, do some additional munging... + if {$index != -1} { + + # we need to find the part of the first item that is + # unique WRT the second... I know there's probably a + # simpler way to do this... + + set nextIndex [expr {$index + 1}] + set nextItem [lindex $list $nextIndex] + + # we don't really need to do much if the next + # item doesn't match our pattern... + if {[string match $pattern* $nextItem]} { + # ok, the next item matches our pattern, too + # now the trick is to find the first character + # where they *don't* match... + set marker [string length $pattern] + while {$marker <= [string length $pattern]} { + set a [string index $thisItem $marker] + set b [string index $nextItem $marker] + if {[string compare $a $b] == 0} { + append pattern $a + incr marker + } else { + break + } + } + } else { + set marker [string length $pattern] + } + + } else { + set marker end + set index 0 + } + + # ok, we know the pattern and what part is unique; + # update the entry widget and listbox appropriately + if {$exact && $exactMatch == -1} { + # this means we didn't find an exact match + $widgets(listbox) selection clear 0 end + $widgets(listbox) see $index + + } elseif {!$exact} { + # this means we found something, but it isn't an exact + # match. If we find something that *is* an exact match we + # don't need to do the following, since it would merely + # be replacing the data in the entry widget with itself + set oldstate [$widgets(entry) cget -state] + $widgets(entry) configure -state normal + $widgets(entry) delete 0 end + $widgets(entry) insert end $thisItem + $widgets(entry) selection clear + $widgets(entry) selection range $marker end + $widgets(listbox) activate $index + $widgets(listbox) selection clear 0 end + $widgets(listbox) selection anchor $index + $widgets(listbox) selection set $index + $widgets(listbox) see $index + $widgets(entry) configure -state $oldstate + } +} + +# ::combobox::Select -- +# +# selects an item from the list and sets the value of the combobox +# to that value +# +# Arguments: +# +# w widget pathname +# index listbox index of item to be selected +# +# Returns: +# +# empty string + +proc ::combobox::Select {w index} { + upvar ::combobox::${w}::widgets widgets + upvar ::combobox::${w}::options options + + # the catch is because I'm sloppy -- presumably, the only time + # an error will be caught is if there is no selection. + if {![catch {set data [$widgets(listbox) get [lindex $index 0]]}]} { + ::combobox::SetValue $widgets(this) $data + + $widgets(listbox) selection clear 0 end + $widgets(listbox) selection anchor $index + $widgets(listbox) selection set $index + + } + $widgets(entry) selection range 0 end + $widgets(entry) icursor end + + $widgets(this) close + + return "" +} + +# ::combobox::HandleScrollbar -- +# +# causes the scrollbar of the dropdown list to appear or disappear +# based on the contents of the dropdown listbox +# +# Arguments: +# +# w widget pathname +# action the action to perform on the scrollbar +# +# Returns: +# +# an empty string + +proc ::combobox::HandleScrollbar {w {action "unknown"}} { + upvar ::combobox::${w}::widgets widgets + upvar ::combobox::${w}::options options + + if {$options(-height) == 0} { + set hlimit $options(-maxheight) + } else { + set hlimit $options(-height) + } + + switch $action { + "grow" { + if {$hlimit > 0 && [$widgets(listbox) size] > $hlimit} { + pack forget $widgets(listbox) + pack $widgets(vsb) -side right -fill y -expand n + pack $widgets(listbox) -side left -fill both -expand y + } + } + + "shrink" { + if {$hlimit > 0 && [$widgets(listbox) size] <= $hlimit} { + pack forget $widgets(vsb) + } + } + + "crop" { + # this means the window was cropped and we definitely + # need a scrollbar no matter what the user wants + pack forget $widgets(listbox) + pack $widgets(vsb) -side right -fill y -expand n + pack $widgets(listbox) -side left -fill both -expand y + } + + default { + if {$hlimit > 0 && [$widgets(listbox) size] > $hlimit} { + pack forget $widgets(listbox) + pack $widgets(vsb) -side right -fill y -expand n + pack $widgets(listbox) -side left -fill both -expand y + } else { + pack forget $widgets(vsb) + } + } + } + + return "" +} + +# ::combobox::ComputeGeometry -- +# +# computes the geometry of the dropdown list based on the size of the +# combobox... +# +# Arguments: +# +# w widget pathname +# +# Returns: +# +# the desired geometry of the listbox + +proc ::combobox::ComputeGeometry {w} { + upvar ::combobox::${w}::widgets widgets + upvar ::combobox::${w}::options options + + if {$options(-height) == 0 && $options(-maxheight) != "0"} { + # if this is the case, count the items and see if + # it exceeds our maxheight. If so, set the listbox + # size to maxheight... + set nitems [$widgets(listbox) size] + if {$nitems > $options(-maxheight)} { + # tweak the height of the listbox + $widgets(listbox) configure -height $options(-maxheight) + } else { + # un-tweak the height of the listbox + $widgets(listbox) configure -height 0 + } + update idletasks + } + + # compute height and width of the dropdown list + set bd [$widgets(dropdown) cget -borderwidth] + set height [expr {[winfo reqheight $widgets(dropdown)] + $bd + $bd}] + if {[string length $options(-dropdownwidth)] == 0 || + $options(-dropdownwidth) == 0} { + set width [winfo width $widgets(this)] + } else { + set m [font measure [$widgets(listbox) cget -font] "m"] + set width [expr {$options(-dropdownwidth) * $m}] + } + + # figure out where to place it on the screen, trying to take into + # account we may be running under some virtual window manager + set screenWidth [winfo screenwidth $widgets(this)] + set screenHeight [winfo screenheight $widgets(this)] + set rootx [winfo rootx $widgets(this)] + set rooty [winfo rooty $widgets(this)] + set vrootx [winfo vrootx $widgets(this)] + set vrooty [winfo vrooty $widgets(this)] + + # the x coordinate is simply the rootx of our widget, adjusted for + # the virtual window. We won't worry about whether the window will + # be offscreen to the left or right -- we want the illusion that it + # is part of the entry widget, so if part of the entry widget is off- + # screen, so will the list. If you want to change the behavior, + # simply change the if statement... (and be sure to update this + # comment!) + set x [expr {$rootx + $vrootx}] + if {0} { + set rightEdge [expr {$x + $width}] + if {$rightEdge > $screenWidth} { + set x [expr {$screenWidth - $width}] + } + if {$x < 0} {set x 0} + } + + # the y coordinate is the rooty plus vrooty offset plus + # the height of the static part of the widget plus 1 for a + # tiny bit of visual separation... + set y [expr {$rooty + $vrooty + [winfo reqheight $widgets(this)] + 1}] + set bottomEdge [expr {$y + $height}] + + if {$bottomEdge >= $screenHeight} { + # ok. Fine. Pop it up above the entry widget isntead of + # below. + set y [expr {($rooty - $height - 1) + $vrooty}] + + if {$y < 0} { + # this means it extends beyond our screen. How annoying. + # Now we'll try to be real clever and either pop it up or + # down, depending on which way gives us the biggest list. + # then, we'll trim the list to fit and force the use of + # a scrollbar + + # (sadly, for windows users this measurement doesn't + # take into consideration the height of the taskbar, + # but don't blame me -- there isn't any way to detect + # it or figure out its dimensions. The same probably + # applies to any window manager with some magic windows + # glued to the top or bottom of the screen) + + if {$rooty > [expr {$screenHeight / 2}]} { + # we are in the lower half of the screen -- + # pop it up. Y is zero; that parts easy. The height + # is simply the y coordinate of our widget, minus + # a pixel for some visual separation. The y coordinate + # will be the topof the screen. + set y 1 + set height [expr {$rooty - 1 - $y}] + + } else { + # we are in the upper half of the screen -- + # pop it down + set y [expr {$rooty + $vrooty + \ + [winfo reqheight $widgets(this)] + 1}] + set height [expr {$screenHeight - $y}] + + } + + # force a scrollbar + HandleScrollbar $widgets(this) crop + } + } + + if {$y < 0} { + # hmmm. Bummer. + set y 0 + set height $screenheight + } + + set geometry [format "=%dx%d+%d+%d" $width $height $x $y] + + return $geometry +} + +# ::combobox::DoInternalWidgetCommand -- +# +# perform an internal widget command, then mung any error results +# to look like it came from our megawidget. A lot of work just to +# give the illusion that our megawidget is an atomic widget +# +# Arguments: +# +# w widget pathname +# subwidget pathname of the subwidget +# command subwidget command to be executed +# args arguments to the command +# +# Returns: +# +# The result of the subwidget command, or an error + +proc ::combobox::DoInternalWidgetCommand {w subwidget command args} { + upvar ::combobox::${w}::widgets widgets + upvar ::combobox::${w}::options options + + set subcommand $command + set command [concat $widgets($subwidget) $command $args] + if {[catch $command result]} { + # replace the subwidget name with the megawidget name + regsub $widgets($subwidget) $result $widgets(this) result + + # replace specific instances of the subwidget command + # with our megawidget command + switch $subwidget,$subcommand { + listbox,index {regsub "index" $result "list index" result} + listbox,insert {regsub "insert" $result "list insert" result} + listbox,delete {regsub "delete" $result "list delete" result} + listbox,get {regsub "get" $result "list get" result} + listbox,size {regsub "size" $result "list size" result} + } + error $result + + } else { + return $result + } +} + + +# ::combobox::WidgetProc -- +# +# This gets uses as the widgetproc for an combobox widget. +# Notice where the widget is created and you'll see that the +# actual widget proc merely evals this proc with all of the +# arguments intact. +# +# Note that some widget commands are defined "inline" (ie: +# within this proc), and some do most of their work in +# separate procs. This is merely because sometimes it was +# easier to do it one way or the other. +# +# Arguments: +# +# w widget pathname +# command widget subcommand +# args additional arguments; varies with the subcommand +# +# Results: +# +# Performs the requested widget command + +proc ::combobox::WidgetProc {w command args} { + upvar ::combobox::${w}::widgets widgets + upvar ::combobox::${w}::options options + upvar ::combobox::${w}::oldFocus oldFocus + upvar ::combobox::${w}::oldFocus oldGrab + + set command [::combobox::Canonize $w command $command] + + # this is just shorthand notation... + set doWidgetCommand \ + [list ::combobox::DoInternalWidgetCommand $widgets(this)] + + if {$command == "list"} { + # ok, the next argument is a list command; we'll + # rip it from args and append it to command to + # create a unique internal command + # + # NB: because of the sloppy way we are doing this, + # we'll also let the user enter our secret command + # directly (eg: listinsert, listdelete), but we + # won't document that fact + set command "list-[lindex $args 0]" + set args [lrange $args 1 end] + } + + set result "" + + # many of these commands are just synonyms for specific + # commands in one of the subwidgets. We'll get them out + # of the way first, then do the custom commands. + switch $command { + bbox - + delete - + get - + icursor - + index - + insert - + scan - + selection - + xview { + set result [eval $doWidgetCommand entry $command $args] + } + list-get {set result [eval $doWidgetCommand listbox get $args]} + list-index {set result [eval $doWidgetCommand listbox index $args]} + list-size {set result [eval $doWidgetCommand listbox size $args]} + + select { + if {[llength $args] == 1} { + set index [lindex $args 0] + set result [Select $widgets(this) $index] + } else { + error "usage: $w select index" + } + } + + subwidget { + set knownWidgets [list button entry listbox dropdown vsb] + if {[llength $args] == 0} { + return $knownWidgets + } + + set name [lindex $args 0] + if {[lsearch $knownWidgets $name] != -1} { + set result $widgets($name) + } else { + error "unknown subwidget $name" + } + } + + curselection { + set result [eval $doWidgetCommand listbox curselection] + } + + list-insert { + eval $doWidgetCommand listbox insert $args + set result [HandleScrollbar $w "grow"] + } + + list-delete { + eval $doWidgetCommand listbox delete $args + set result [HandleScrollbar $w "shrink"] + } + + toggle { + # ignore this command if the widget is disabled... + if {$options(-state) == "disabled"} return + + # pops down the list if it is not, hides it + # if it is... + if {[winfo ismapped $widgets(dropdown)]} { + set result [$widgets(this) close] + } else { + set result [$widgets(this) open] + } + } + + open { + + # if this is an editable combobox, the focus should + # be set to the entry widget + if {$options(-editable)} { + focus $widgets(entry) + $widgets(entry) select range 0 end + $widgets(entry) icursor end + } + + # if we are disabled, we won't allow this to happen + if {$options(-state) == "disabled"} { + return 0 + } + + # if there is a -opencommand, execute it now + if {[string length $options(-opencommand)] > 0} { + # hmmm... should I do a catch, or just let the normal + # error handling handle any errors? For now, the latter... + uplevel \#0 $options(-opencommand) + } + + # compute the geometry of the window to pop up, and set + # it, and force the window manager to take notice + # (even if it is not presently visible). + # + # this isn't strictly necessary if the window is already + # mapped, but we'll go ahead and set the geometry here + # since its harmless and *may* actually reset the geometry + # to something better in some weird case. + set geometry [::combobox::ComputeGeometry $widgets(this)] + wm geometry $widgets(dropdown) $geometry + update idletasks + + # if we are already open, there's nothing else to do + if {[winfo ismapped $widgets(dropdown)]} { + return 0 + } + + # save the widget that currently has the focus; we'll restore + # the focus there when we're done + set oldFocus [focus] + + # ok, tweak the visual appearance of things and + # make the list pop up + $widgets(button) configure -relief sunken + wm deiconify $widgets(dropdown) + update idletasks + raise $widgets(dropdown) + + # force focus to the entry widget so we can handle keypress + # events for traversal + focus -force $widgets(entry) + + # select something by default, but only if its an + # exact match... + ::combobox::Find $widgets(this) 1 + + # save the current grab state for the display containing + # this widget. We'll restore it when we close the dropdown + # list + set status "none" + set grab [grab current $widgets(this)] + if {$grab != ""} {set status [grab status $grab]} + set oldGrab [list $grab $status] + unset grab status + + # *gasp* do a global grab!!! Mom always told me not to + # do things like this, but sometimes a man's gotta do + # what a man's gotta do. + grab -global $widgets(this) + + # fake the listbox into thinking it has focus. This is + # necessary to get scanning initialized properly in the + # listbox. + event generate $widgets(listbox) <B1-Enter> + + return 1 + } + + close { + # if we are already closed, don't do anything... + if {![winfo ismapped $widgets(dropdown)]} { + return 0 + } + + # restore the focus and grab, but ignore any errors... + # we're going to be paranoid and release the grab before + # trying to set any other grab because we really really + # really want to make sure the grab is released. + catch {focus $oldFocus} result + catch {grab release $widgets(this)} + catch { + set status [lindex $oldGrab 1] + if {$status == "global"} { + grab -global [lindex $oldGrab 0] + } elseif {$status == "local"} { + grab [lindex $oldGrab 0] + } + unset status + } + + # hides the listbox + $widgets(button) configure -relief raised + wm withdraw $widgets(dropdown) + + # select the data in the entry widget. Not sure + # why, other than observation seems to suggest that's + # what windows widgets do. + set editable [::combobox::GetBoolean $options(-editable)] + if {$editable} { + $widgets(entry) selection range 0 end + $widgets(button) configure -relief raised + } + + + # magic tcl stuff (see tk.tcl in the distribution + # lib directory) + ::combobox::tkCancelRepeat + + return 1 + } + + cget { + if {[llength $args] != 1} { + error "wrong # args: should be $w cget option" + } + set opt [::combobox::Canonize $w option [lindex $args 0]] + + if {$opt == "-value"} { + set result [$widgets(entry) get] + } else { + set result $options($opt) + } + } + + configure { + set result [eval ::combobox::Configure {$w} $args] + } + + default { + error "bad option \"$command\"" + } + } + + return $result +} + +# ::combobox::Configure -- +# +# Implements the "configure" widget subcommand +# +# Arguments: +# +# w widget pathname +# args zero or more option/value pairs (or a single option) +# +# Results: +# +# Performs typcial "configure" type requests on the widget + +proc ::combobox::Configure {w args} { + variable widgetOptions + variable defaultEntryCursor + + upvar ::combobox::${w}::widgets widgets + upvar ::combobox::${w}::options options + + if {[llength $args] == 0} { + # hmmm. User must be wanting all configuration information + # note that if the value of an array element is of length + # one it is an alias, which needs to be handled slightly + # differently + set results {} + foreach opt [lsort [array names widgetOptions]] { + if {[llength $widgetOptions($opt)] == 1} { + set alias $widgetOptions($opt) + set optName $widgetOptions($alias) + lappend results [list $opt $optName] + } else { + set optName [lindex $widgetOptions($opt) 0] + set optClass [lindex $widgetOptions($opt) 1] + set default [option get $w $optName $optClass] + if {[info exists options($opt)]} { + lappend results [list $opt $optName $optClass \ + $default $options($opt)] + } else { + lappend results [list $opt $optName $optClass \ + $default ""] + } + } + } + + return $results + } + + # one argument means we are looking for configuration + # information on a single option + if {[llength $args] == 1} { + set opt [::combobox::Canonize $w option [lindex $args 0]] + + set optName [lindex $widgetOptions($opt) 0] + set optClass [lindex $widgetOptions($opt) 1] + set default [option get $w $optName $optClass] + set results [list $opt $optName $optClass \ + $default $options($opt)] + return $results + } + + # if we have an odd number of values, bail. + if {[expr {[llength $args]%2}] == 1} { + # hmmm. An odd number of elements in args + error "value for \"[lindex $args end]\" missing" + } + + # Great. An even number of options. Let's make sure they + # are all valid before we do anything. Note that Canonize + # will generate an error if it finds a bogus option; otherwise + # it returns the canonical option name + foreach {name value} $args { + set name [::combobox::Canonize $w option $name] + set opts($name) $value + } + + # process all of the configuration options + # some (actually, most) options require us to + # do something, like change the attributes of + # a widget or two. Here's where we do that... + # + # note that the handling of disabledforeground and + # disabledbackground is a little wonky. First, we have + # to deal with backwards compatibility (ie: tk 8.3 and below + # didn't have such options for the entry widget), and + # we have to deal with the fact we might want to disable + # the entry widget but use the normal foreground/background + # for when the combobox is not disabled, but not editable either. + + set updateVisual 0 + foreach option [array names opts] { + set newValue $opts($option) + if {[info exists options($option)]} { + set oldValue $options($option) + } + + switch -- $option { + -buttonbackground { + $widgets(button) configure -background $newValue + } + -background { + set updateVisual 1 + set options($option) $newValue + } + + -borderwidth { + $widgets(frame) configure -borderwidth $newValue + set options($option) $newValue + } + + -command { + # nothing else to do... + set options($option) $newValue + } + + -commandstate { + # do some value checking... + if {$newValue != "normal" && $newValue != "disabled"} { + set options($option) $oldValue + set message "bad state value \"$newValue\";" + append message " must be normal or disabled" + error $message + } + set options($option) $newValue + } + + -cursor { + $widgets(frame) configure -cursor $newValue + $widgets(entry) configure -cursor $newValue + $widgets(listbox) configure -cursor $newValue + set options($option) $newValue + } + + -disabledforeground { + set updateVisual 1 + set options($option) $newValue + } + + -disabledbackground { + set updateVisual 1 + set options($option) $newValue + } + + -dropdownwidth { + set options($option) $newValue + } + + -editable { + set updateVisual 1 + if {$newValue} { + # it's editable... + $widgets(entry) configure \ + -state normal \ + -cursor $defaultEntryCursor + } else { + $widgets(entry) configure \ + -state disabled \ + -cursor $options(-cursor) + } + set options($option) $newValue + } + + -elementborderwidth { + $widgets(button) configure -borderwidth $newValue + $widgets(vsb) configure -borderwidth $newValue + $widgets(dropdown) configure -borderwidth $newValue + set options($option) $newValue + } + + -font { + $widgets(entry) configure -font $newValue + $widgets(listbox) configure -font $newValue + set options($option) $newValue + } + + -foreground { + set updateVisual 1 + set options($option) $newValue + } + + -height { + $widgets(listbox) configure -height $newValue + HandleScrollbar $w + set options($option) $newValue + } + + -highlightbackground { + $widgets(frame) configure -highlightbackground $newValue + set options($option) $newValue + } + + -highlightcolor { + $widgets(frame) configure -highlightcolor $newValue + set options($option) $newValue + } + + -highlightthickness { + $widgets(frame) configure -highlightthickness $newValue + set options($option) $newValue + } + + -image { + if {[string length $newValue] > 0} { + puts "old button width: [$widgets(button) cget -width]" + $widgets(button) configure \ + -image $newValue \ + -width [expr {[image width $newValue] + 2}] + puts "new button width: [$widgets(button) cget -width]" + + } else { + $widgets(button) configure -image ::combobox::bimage + } + set options($option) $newValue + } + + -listvar { + if {[catch {$widgets(listbox) cget -listvar}]} { + return -code error \ + "-listvar not supported with this version of tk" + } + $widgets(listbox) configure -listvar $newValue + set options($option) $newValue + } + + -maxheight { + # ComputeGeometry may dork with the actual height + # of the listbox, so let's undork it + $widgets(listbox) configure -height $options(-height) + HandleScrollbar $w + set options($option) $newValue + } + + -opencommand { + # nothing else to do... + set options($option) $newValue + } + + -relief { + $widgets(frame) configure -relief $newValue + set options($option) $newValue + } + + -selectbackground { + $widgets(entry) configure -selectbackground $newValue + $widgets(listbox) configure -selectbackground $newValue + set options($option) $newValue + } + + -selectborderwidth { + $widgets(entry) configure -selectborderwidth $newValue + $widgets(listbox) configure -selectborderwidth $newValue + set options($option) $newValue + } + + -selectforeground { + $widgets(entry) configure -selectforeground $newValue + $widgets(listbox) configure -selectforeground $newValue + set options($option) $newValue + } + + -state { + if {$newValue == "normal"} { + set updateVisual 1 + # it's enabled + + set editable [::combobox::GetBoolean \ + $options(-editable)] + if {$editable} { + $widgets(entry) configure -state normal + $widgets(entry) configure -takefocus 1 + } + + # note that $widgets(button) is actually a label, + # not a button. And being able to disable labels + # wasn't possible until tk 8.3. (makes me wonder + # why I chose to use a label, but that answer is + # lost to antiquity) + if {[info patchlevel] >= 8.3} { + $widgets(button) configure -state normal + } + + } elseif {$newValue == "disabled"} { + set updateVisual 1 + # it's disabled + $widgets(entry) configure -state disabled + $widgets(entry) configure -takefocus 0 + # note that $widgets(button) is actually a label, + # not a button. And being able to disable labels + # wasn't possible until tk 8.3. (makes me wonder + # why I chose to use a label, but that answer is + # lost to antiquity) + if {$::tcl_version >= 8.3} { + $widgets(button) configure -state disabled + } + + } else { + set options($option) $oldValue + set message "bad state value \"$newValue\";" + append message " must be normal or disabled" + error $message + } + + set options($option) $newValue + } + + -takefocus { + $widgets(entry) configure -takefocus $newValue + set options($option) $newValue + } + + -textvariable { + $widgets(entry) configure -textvariable $newValue + set options($option) $newValue + } + + -value { + ::combobox::SetValue $widgets(this) $newValue + set options($option) $newValue + } + + -width { + $widgets(entry) configure -width $newValue + $widgets(listbox) configure -width $newValue + set options($option) $newValue + } + + -xscrollcommand { + $widgets(entry) configure -xscrollcommand $newValue + set options($option) $newValue + } + } + + if {$updateVisual} {UpdateVisualAttributes $w} + } +} + +# ::combobox::UpdateVisualAttributes -- +# +# sets the visual attributes (foreground, background mostly) +# based on the current state of the widget (normal/disabled, +# editable/non-editable) +# +# why a proc for such a simple thing? Well, in addition to the +# various states of the widget, we also have to consider the +# version of tk being used -- versions from 8.4 and beyond have +# the notion of disabled foreground/background options for various +# widgets. All of the permutations can get nasty, so we encapsulate +# it all in one spot. +# +# note also that we don't handle all visual attributes here; just +# the ones that depend on the state of the widget. The rest are +# handled on a case by case basis +# +# Arguments: +# w widget pathname +# +# Returns: +# empty string + +proc ::combobox::UpdateVisualAttributes {w} { + + upvar ::combobox::${w}::widgets widgets + upvar ::combobox::${w}::options options + + if {$options(-state) == "normal"} { + + set foreground $options(-foreground) + set background $options(-background) + + } elseif {$options(-state) == "disabled"} { + + set foreground $options(-disabledforeground) + set background $options(-disabledbackground) + } + + $widgets(entry) configure -foreground $foreground -background $background + $widgets(listbox) configure -foreground $foreground -background $background + $widgets(button) configure -foreground $foreground + $widgets(vsb) configure -background $background -troughcolor $background + $widgets(frame) configure -background $background + + # we need to set the disabled colors in case our widget is disabled. + # We could actually check for disabled-ness, but we also need to + # check whether we're enabled but not editable, in which case the + # entry widget is disabled but we still want the enabled colors. It's + # easier just to set everything and be done with it. + + if {$::tcl_version >= 8.4} { + $widgets(entry) configure \ + -disabledforeground $foreground \ + -disabledbackground $background + $widgets(button) configure -disabledforeground $foreground + $widgets(listbox) configure -disabledforeground $foreground + } +} + +# ::combobox::SetValue -- +# +# sets the value of the combobox and calls the -command, +# if defined +# +# Arguments: +# +# w widget pathname +# newValue the new value of the combobox +# +# Returns +# +# Empty string + +proc ::combobox::SetValue {w newValue} { + + upvar ::combobox::${w}::widgets widgets + upvar ::combobox::${w}::options options + upvar ::combobox::${w}::ignoreTrace ignoreTrace + upvar ::combobox::${w}::oldValue oldValue + + if {[info exists options(-textvariable)] \ + && [string length $options(-textvariable)] > 0} { + set variable ::$options(-textvariable) + set $variable $newValue + } else { + set oldstate [$widgets(entry) cget -state] + $widgets(entry) configure -state normal + $widgets(entry) delete 0 end + $widgets(entry) insert 0 $newValue + $widgets(entry) configure -state $oldstate + } + + # set our internal textvariable; this will cause any public + # textvariable (ie: defined by the user) to be updated as + # well +# set ::combobox::${w}::entryTextVariable $newValue + + # redefine our concept of the "old value". Do it before running + # any associated command so we can be sure it happens even + # if the command somehow fails. + set oldValue $newValue + + + # call the associated command. The proc will handle whether or + # not to actually call it, and with what args + CallCommand $w $newValue + + return "" +} + +# ::combobox::CallCommand -- +# +# calls the associated command, if any, appending the new +# value to the command to be called. +# +# Arguments: +# +# w widget pathname +# newValue the new value of the combobox +# +# Returns +# +# empty string + +proc ::combobox::CallCommand {w newValue} { + upvar ::combobox::${w}::widgets widgets + upvar ::combobox::${w}::options options + + # call the associated command, if defined and -commandstate is + # set to "normal" + if {$options(-commandstate) == "normal" && \ + [string length $options(-command)] > 0} { + set args [list $widgets(this) $newValue] + uplevel \#0 $options(-command) $args + } +} + + +# ::combobox::GetBoolean -- +# +# returns the value of a (presumably) boolean string (ie: it should +# do the right thing if the string is "yes", "no", "true", 1, etc +# +# Arguments: +# +# value value to be converted +# errorValue a default value to be returned in case of an error +# +# Returns: +# +# a 1 or zero, or the value of errorValue if the string isn't +# a proper boolean value + +proc ::combobox::GetBoolean {value {errorValue 1}} { + if {[catch {expr {([string trim $value])?1:0}} res]} { + return $errorValue + } else { + return $res + } +} + +# ::combobox::convert -- +# +# public routine to convert %x, %y and %W binding substitutions. +# Given an x, y and or %W value relative to a given widget, this +# routine will convert the values to be relative to the combobox +# widget. For example, it could be used in a binding like this: +# +# bind .combobox <blah> {doSomething [::combobox::convert %W -x %x]} +# +# Note that this procedure is *not* exported, but is intended for +# public use. It is not exported because the name could easily +# clash with existing commands. +# +# Arguments: +# +# w a widget path; typically the actual result of a %W +# substitution in a binding. It should be either a +# combobox widget or one of its subwidgets +# +# args should one or more of the following arguments or +# pairs of arguments: +# +# -x <x> will convert the value <x>; typically <x> will +# be the result of a %x substitution +# -y <y> will convert the value <y>; typically <y> will +# be the result of a %y substitution +# -W (or -w) will return the name of the combobox widget +# which is the parent of $w +# +# Returns: +# +# a list of the requested values. For example, a single -w will +# result in a list of one items, the name of the combobox widget. +# Supplying "-x 10 -y 20 -W" (in any order) will return a list of +# three values: the converted x and y values, and the name of +# the combobox widget. + +proc ::combobox::convert {w args} { + set result {} + if {![winfo exists $w]} { + error "window \"$w\" doesn't exist" + } + + while {[llength $args] > 0} { + set option [lindex $args 0] + set args [lrange $args 1 end] + + switch -exact -- $option { + -x { + set value [lindex $args 0] + set args [lrange $args 1 end] + set win $w + while {[winfo class $win] != "Combobox"} { + incr value [winfo x $win] + set win [winfo parent $win] + if {$win == "."} break + } + lappend result $value + } + + -y { + set value [lindex $args 0] + set args [lrange $args 1 end] + set win $w + while {[winfo class $win] != "Combobox"} { + incr value [winfo y $win] + set win [winfo parent $win] + if {$win == "."} break + } + lappend result $value + } + + -w - + -W { + set win $w + while {[winfo class $win] != "Combobox"} { + set win [winfo parent $win] + if {$win == "."} break; + } + lappend result $win + } + } + } + return $result +} + +# ::combobox::Canonize -- +# +# takes a (possibly abbreviated) option or command name and either +# returns the canonical name or an error +# +# Arguments: +# +# w widget pathname +# object type of object to canonize; must be one of "command", +# "option", "scan command" or "list command" +# opt the option (or command) to be canonized +# +# Returns: +# +# Returns either the canonical form of an option or command, +# or raises an error if the option or command is unknown or +# ambiguous. + +proc ::combobox::Canonize {w object opt} { + variable widgetOptions + variable columnOptions + variable widgetCommands + variable listCommands + variable scanCommands + + switch $object { + command { + if {[lsearch -exact $widgetCommands $opt] >= 0} { + return $opt + } + + # command names aren't stored in an array, and there + # isn't a way to get all the matches in a list, so + # we'll stuff the commands in a temporary array so + # we can use [array names] + set list $widgetCommands + foreach element $list { + set tmp($element) "" + } + set matches [array names tmp ${opt}*] + } + + {list command} { + if {[lsearch -exact $listCommands $opt] >= 0} { + return $opt + } + + # command names aren't stored in an array, and there + # isn't a way to get all the matches in a list, so + # we'll stuff the commands in a temporary array so + # we can use [array names] + set list $listCommands + foreach element $list { + set tmp($element) "" + } + set matches [array names tmp ${opt}*] + } + + {scan command} { + if {[lsearch -exact $scanCommands $opt] >= 0} { + return $opt + } + + # command names aren't stored in an array, and there + # isn't a way to get all the matches in a list, so + # we'll stuff the commands in a temporary array so + # we can use [array names] + set list $scanCommands + foreach element $list { + set tmp($element) "" + } + set matches [array names tmp ${opt}*] + } + + option { + if {[info exists widgetOptions($opt)] \ + && [llength $widgetOptions($opt)] == 2} { + return $opt + } + set list [array names widgetOptions] + set matches [array names widgetOptions ${opt}*] + } + + } + + if {[llength $matches] == 0} { + set choices [HumanizeList $list] + error "unknown $object \"$opt\"; must be one of $choices" + + } elseif {[llength $matches] == 1} { + set opt [lindex $matches 0] + + # deal with option aliases + switch $object { + option { + set opt [lindex $matches 0] + if {[llength $widgetOptions($opt)] == 1} { + set opt $widgetOptions($opt) + } + } + } + + return $opt + + } else { + set choices [HumanizeList $list] + error "ambiguous $object \"$opt\"; must be one of $choices" + } +} + +# ::combobox::HumanizeList -- +# +# Returns a human-readable form of a list by separating items +# by columns, but separating the last two elements with "or" +# (eg: foo, bar or baz) +# +# Arguments: +# +# list a valid tcl list +# +# Results: +# +# A string which as all of the elements joined with ", " or +# the word " or " + +proc ::combobox::HumanizeList {list} { + + if {[llength $list] == 1} { + return [lindex $list 0] + } else { + set list [lsort $list] + set secondToLast [expr {[llength $list] -2}] + set most [lrange $list 0 $secondToLast] + set last [lindex $list end] + + return "[join $most {, }] or $last" + } +} + +# This is some backwards-compatibility code to handle TIP 44 +# (http://purl.org/tcl/tip/44.html). For all private tk commands +# used by this widget, we'll make duplicates of the procs in the +# combobox namespace. +# +# I'm not entirely convinced this is the right thing to do. I probably +# shouldn't even be using the private commands. Then again, maybe the +# private commands really should be public. Oh well; it works so it +# must be OK... +foreach command {TabToWindow CancelRepeat ListboxUpDown} { + if {[llength [info commands ::combobox::tk$command]] == 1} break; + + set tmp [info commands tk$command] + set proc ::combobox::tk$command + if {[llength [info commands tk$command]] == 1} { + set command [namespace which [lindex $tmp 0]] + proc $proc {args} "uplevel $command \$args" + } else { + if {[llength [info commands ::tk::$command]] == 1} { + proc $proc {args} "uplevel ::tk::$command \$args" + } + } +} + +# end of combobox.tcl + diff --git a/modules/tclsci/tcl/sciGUI/local_extra/combobox-2.3/example.tcl b/modules/tclsci/tcl/sciGUI/local_extra/combobox-2.3/example.tcl new file mode 100755 index 000000000..41c9bbbc5 --- /dev/null +++ b/modules/tclsci/tcl/sciGUI/local_extra/combobox-2.3/example.tcl @@ -0,0 +1,163 @@ +# A simple font display utility. +# +# This program uses two variations of the combobox. One, for the font +# family, is non-editable (ie: the user can only pick from the list). +# The other, for font size, is editable. The user can pick from the list +# or enter their own size + +# substitute your favorite method here... +source combobox.tcl +package require combobox 2.3 +catch {namespace import combobox::*} + +proc main {} { + # this lets us be reentrant... + destroy .fontpicker .msg + + # default values + set ::size 12 + set ::family [lindex [lsort [font families]] 0] + set ::slant roman + set ::weight normal + set ::overstrike 0 + set ::underline 0 + + wm title . "Combobox Example" + + # the main two areas: a frame to hold the font picker widgets + # and a label to display a sample from the font + set fp [frame .fontpicker] + set msg [label .msg -borderwidth 2 -relief groove -width 30 -height 4] + + pack $fp -side top -fill x + pack $msg -side top -fill both -expand y -pady 2 + + $msg configure -text [join [list \ + "ABCDEFGHIJKLMNOPQRSTUVWXYZ" \ + "abcdefghijklmnopqrstuvwxyz" \ + "0123456789~`!@#$%^&*()_-+=" \ + "{}[]:;\"'<>,.?/"] "\n"] + + # this will set the font of the message according to our defaults + changeFont $msg + + # font family... + label $fp.famLabel -text "Font Family:" + combobox $fp.famCombo \ + -borderwidth 1 \ + -textvariable family \ + -editable false \ + -highlightthickness 1 \ + -command [list changeFont $msg] + + + grid $fp.famLabel -row 0 -column 0 -sticky e + grid $fp.famCombo -row 0 -column 1 -sticky ew + grid columnconfigure $fp 1 -weight 1 + + # we'll do these one at a time so we can find the widest one and + # set the width of the combobox accordingly (hmmm... wonder if this + # sort of thing should be done by the combobox itself...?) + set widest 0 + foreach family [lsort [font families]] { + if {[set length [string length $family]] > $widest} { + set widest $length + } + $fp.famCombo list insert end $family + } + $fp.famCombo configure -width $widest + + # the font size. We know we are puting a fairly small, finite + # number of items in this combobox, so we'll set its maxheight + # to zero so it will grow to fit the number of items + label $fp.sizeLabel -text "Font Size:" + combobox $fp.sizeCombo \ + -borderwidth 1 \ + -highlightthickness 1 \ + -maxheight 0 \ + -width 3 \ + -textvariable size \ + -editable true \ + -command [list changeFont $msg] + + grid $fp.sizeLabel -row 0 -column 2 -sticky e -padx 2 + grid $fp.sizeCombo -row 0 -column 3 -sticky new + grid columnconfigure $fp 3 -weight 1 + eval $fp.sizeCombo list insert end [list 8 9 10 12 14 16 18 20 24 28 32 36] + + # a dummy frame to give a little spacing... + frame $fp.dummy -width 5 + grid $fp.dummy -row 0 -column 4 + + # bold + set bold "bold" + checkbutton $fp.bold -variable weight -indicatoron false \ + -onvalue bold -offvalue normal \ + -text "B" -width 2 -height 1 \ + -font {-weight bold -family Times -size 12} \ + -highlightthickness 1 -padx 0 -pady 0 -borderwidth 1 \ + -command [list changeFont $msg] + grid $fp.bold -row 0 -column 5 -sticky nsew + + # underline + checkbutton $fp.underline -variable underline -indicatoron false \ + -onvalue 1 -offvalue 0 \ + -text "U" -width 2 -height 1 \ + -font {-underline 1 -family Times -size 12} \ + -highlightthickness 1 -padx 0 -pady 0 -borderwidth 1 \ + -command [list changeFont $msg] + grid $fp.underline -row 0 -column 6 -sticky nsew + + # italic + checkbutton $fp.italic -variable slant -indicatoron false \ + -onvalue italic -offvalue roman \ + -text "I" -width 2 -height 1 \ + -font {-slant italic -family Times -size 12} \ + -highlightthickness 1 -padx 0 -pady 0 -borderwidth 1 \ + -command [list changeFont $msg] + grid $fp.italic -row 0 -column 7 -sticky nsew + + # overstrike + checkbutton $fp.overstrike -variable overstrike -indicatoron false \ + -onvalue 1 -offvalue 0 \ + -text "O" -width 2 -height 1 \ + -font {-overstrike 1 -family Times -size 12} \ + -highlightthickness 1 -padx 0 -pady 0 -borderwidth 1 \ + -command [list changeFont $msg] + grid $fp.overstrike -row 0 -column 8 -sticky nsew + + # this gives us relatively square buttons that fill the frame + # in the Y direction + bind $fp <Configure> { + grid columnconfigure %W 5 -minsize %h + grid columnconfigure %W 6 -minsize %h + grid columnconfigure %W 7 -minsize %h + grid columnconfigure %W 8 -minsize %h + } + # put focus on the first widget + catch {focus $fp.famCombo} + + return "" +} + +# this proc changes the font. It is called by various methods, so +# the only parameter we are guaranteed is the first one since +# we supply it ourselves... +proc ::changeFont {w args} { + foreach foo [list family size weight underline slant overstrike] { + if {[set ::$foo] == ""} { + return + } + } + set ::fontspec [list \ + -family $::family \ + -size $::size \ + -weight $::weight \ + -underline $::underline \ + -slant $::slant \ + -overstrike $::overstrike \ + ] + $w configure -font $::fontspec +} + +main diff --git a/modules/tclsci/tcl/sciGUI/local_extra/rnotebook.tcl b/modules/tclsci/tcl/sciGUI/local_extra/rnotebook.tcl new file mode 100755 index 000000000..6418f8e58 --- /dev/null +++ b/modules/tclsci/tcl/sciGUI/local_extra/rnotebook.tcl @@ -0,0 +1,323 @@ +# A Resizable Notebook widget for Tcl/Tk +# $Revision: 1.1 $ +# +# Copyright (C) 1999 Daniel Roche +# +# This library is free software; you can redistribute it and/or +# modify it under the terms of the GNU Library General Public +# License as published by the Free Software Foundation; either +# version 2 of the License, or (at your option) any later version. +# +# This library is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# Library General Public License for more details. +# +# You should have received a copy of the GNU Library General Public +# License along with this library; if not, write to the +# Free Software Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. +# +# Author contact information: +# daniel.roche@bigfoot.com +# http://www.multimania.com/droche/ +# +# Thanks to Earl Roosa <earl.roosa@db.com> for the addtab patch +# +######################################################### +# +# Rnotebook:create new_widget_name [option value ...] +# where options are : +# [-borderwidth i] set the borderwidth of the tabs and the frame +# [-height i] set the height of the tabs in pixel +# [-tabs tablist] set the tabs according to each element of the list +# [-nbtab i] set the tabs number, by default the tabs are named +# according to their position number +# [-padx i] set the space between each tabs in pixel +# [-background col] set the background color for the tabs and the frame +# [-foreground col] set the background color for the tabs +# +# Rnotebook:config widget_name [option value ...] +# where options are : +# [-borderwidth i] set the borderwidth of the tabs and the frame +# [-height i] set the height of the tabs in pixel +# [-padx i] set the space between each tabs in pixel +# [-background col] set the background color for the tabs and the frame +# [-foreground col] set the background color for the tabs +# [-tabs tablist] set the tabs according to each element of the list +# [-nbtab i] set the tabs number, by default the tabs are named +# according to their position number +# +# Rnotebook:raise widget_name page_number +# raise the specified page number of the specified notebook +# +# Rnotebook:frame widget_name page_number +# return the frame widget associated with the specified page number +# it is a real tcl 'frame' widget and thus can be configured as any other frame. +# +# Rnotebook:button widget_name page_number +# return the button widget associated with the specified page number +# it is a real tcl 'button' widget and thus can be configured as any other button. +# +######################################################### + + +# +# Create a new notebook widget +# +proc Rnotebook:create {w args} { + global Rnotebook tcl_platform + # create/init base widget + frame $w -borderwidth 0 -relief flat + # init default data structure + set Rnotebook($w,nbtab) 1 + set Rnotebook($w,tabs) {1} + set Rnotebook($w,current) 0 + set Rnotebook($w,theight) 30 + set Rnotebook($w,padx) 0 + set Rnotebook($w,bwidth) 2 + set Rnotebook($w,background) [$w cget -background] + set Rnotebook($w,foreground) black + # parse arguments + foreach {tag value} $args { + switch -- $tag { + -borderwidth { + set Rnotebook($w,bwidth) $value + } + -height { + set Rnotebook($w,theight) $value + } + -tabs { + set Rnotebook($w,tabs) $value + set Rnotebook($w,nbtab) [llength $value] + } + -nbtab { + set Rnotebook($w,nbtab) $value + } + -padx { + set Rnotebook($w,padx) $value + } + -background { + set Rnotebook($w,background) $value + } + -foreground { + set Rnotebook($w,foreground) $value + } + } + } + # build associated widgets + frame $w.tabs -borderwidth 0 -relief flat + #-background $Rnotebook($w,background) + frame $w.body -borderwidth $Rnotebook($w,bwidth) -relief raised \ + -background $Rnotebook($w,background) + frame $w.mask -borderwidth 0 -relief flat -background $Rnotebook($w,background) + frame $w.mskl -borderwidth 0 -relief flat -background $Rnotebook($w,background) + if [string compare $tcl_platform(platform) windows] { + # Unix look :-) + frame $w.mskl.ml -borderwidth $Rnotebook($w,bwidth) -relief sunken + place $w.mskl.ml -x -$Rnotebook($w,bwidth) -y -$Rnotebook($w,bwidth) \ + -width [expr 2 * $Rnotebook($w,bwidth)] \ + -height [expr 3 * $Rnotebook($w,bwidth)] + } else { + # losedoze look :-( + frame $w.mskl.ml -borderwidth $Rnotebook($w,bwidth) -relief raised + place $w.mskl.ml -x 0 -y -$Rnotebook($w,bwidth) \ + -width [expr 2 * $Rnotebook($w,bwidth)] \ + -height [expr 4 * $Rnotebook($w,bwidth)] + } + frame $w.mskr -borderwidth 0 -relief flat -background $Rnotebook($w,background) + if [string compare $tcl_platform(platform) windows] { + # Unix look :-) + frame $w.mskr.mr -borderwidth $Rnotebook($w,bwidth) -relief sunken + place $w.mskr.mr -x 0 -y -$Rnotebook($w,bwidth) \ + -width [expr 2 * $Rnotebook($w,bwidth)] \ + -height [expr 3 * $Rnotebook($w,bwidth)] + } else { + # losedoze look :-( + frame $w.mskr.mr -borderwidth $Rnotebook($w,bwidth) -relief raised + place $w.mskr.mr -x -$Rnotebook($w,bwidth) -y -$Rnotebook($w,bwidth) \ + -width [expr 2 * $Rnotebook($w,bwidth)] \ + -height [expr 4 * $Rnotebook($w,bwidth)] + } + place $w.tabs -x 0 -y 0 -relwidth 1.0 -height $Rnotebook($w,theight) + place $w.body -x 0 -y $Rnotebook($w,theight) -relwidth 1.0 \ + -relheight 1.0 -height -$Rnotebook($w,theight) + for {set ind 1} {$ind <= $Rnotebook($w,nbtab)} {incr ind} { + Rnotebook:addtab $w $ind + } + # show page 1 + eval Rnotebook:raise $w 1 +} + +proc Rnotebook:addtab {w ind} { + global Rnotebook + set i2 [expr $ind - 1] + set txt [lindex $Rnotebook($w,tabs) $i2] + if {! [string length $txt] } { + set txt $ind + } + button $w.tabs.b$ind -text $txt -borderwidth $Rnotebook($w,bwidth) \ + -background $Rnotebook($w,background) \ + -foreground $Rnotebook($w,foreground) \ + -command "Rnotebook:raise $w $ind" + pack $w.tabs.b$ind -side left -pady 0 -padx $Rnotebook($w,padx) -fill y + bind $w.tabs.b$ind <Configure> "Rnotebook:raise $w current" + frame $w.body.f$ind -borderwidth 0 -background $Rnotebook($w,background) + +} + +# +# Change configuration options for the notebook widget +# +proc Rnotebook:config {w args} { + global Rnotebook tcl_platform + set nbt $Rnotebook($w,nbtab) + foreach {tag value} $args { + switch -- $tag { + -borderwidth { + set Rnotebook($w,bwidth) $value + $w.body configure -borderwidth $Rnotebook($w,bwidth) + $w.mskl.ml configure -borderwidth $Rnotebook($w,bwidth) + $w.mskr.mr configure -borderwidth $Rnotebook($w,bwidth) + set lst [winfo children $w.tabs] + foreach wid $lst { + $wid configure -borderwidth $Rnotebook($w,bwidth) + } + if [string compare $tcl_platform(platform) windows] { + # Unix look :-) + place $w.mskl.ml -x -$Rnotebook($w,bwidth) \ + -y -$Rnotebook($w,bwidth) \ + -width [expr 2 * $Rnotebook($w,bwidth)] \ + -height [expr 3 * $Rnotebook($w,bwidth)] + } else { + # losedoze look :-( + place $w.mskl.ml -x 0 -y -$Rnotebook($w,bwidth) \ + -width [expr 2 * $Rnotebook($w,bwidth)] \ + -height [expr 4 * $Rnotebook($w,bwidth)] + } + if [string compare $tcl_platform(platform) windows] { + # Unix look :-) + place $w.mskr.mr -x 0 -y -$Rnotebook($w,bwidth) \ + -width [expr 2 * $Rnotebook($w,bwidth)] \ + -height [expr 3 * $Rnotebook($w,bwidth)] + } else { + # losedoze look :-( + place $w.mskr.mr -x -$Rnotebook($w,bwidth) -y \ + -$Rnotebook($w,bwidth) \ + -width [expr 2 * $Rnotebook($w,bwidth)] \ + -height [expr 4 * $Rnotebook($w,bwidth)] + } + } + -background { + set Rnotebook($w,background) $value + $w.body configure -background $Rnotebook($w,background) + $w.mskl.ml configure -background $Rnotebook($w,background) + $w.mskr.mr configure -background $Rnotebook($w,background) + set lst [winfo children $w.tabs] + foreach wid $lst { + $wid configure -background $Rnotebook($w,background) + } + $w.mask configure -background $Rnotebook($w,background) + } + -foreground { + set Rnotebook($w,foreground) $value + set lst [winfo children $w.tabs] + foreach wid $lst { + $wid configure -foreground $Rnotebook($w,foreground) + } + } + -height { + set Rnotebook($w,theight) $value + place $w.tabs -x 0 -y 0 -relwidth 1.0 -height $Rnotebook($w,theight) + place $w.body -x 0 -y $Rnotebook($w,theight) -relwidth 1.0 \ + -relheight 1.0 -height -$Rnotebook($w,theight) + } + -padx { + set Rnotebook($w,padx) $value + set lst [winfo children $w.tabs] + foreach wid $lst { + pack $wid -padx $Rnotebook($w,padx) + } + } + -tabs { + set Rnotebook($w,tabs) $value + set Rnotebook($w,nbtab) [llength $value] + } + -nbtab { + set Rnotebook($w,nbtab) $value + } + } + } + if {$nbt < $Rnotebook($w,nbtab)} { + for {set ind [expr $nbt+1]} {$ind <= $Rnotebook($w,nbtab)} {incr ind} { + Rnotebook:addtab $w $ind + } + } +} + +# +# This procedure raises a notebook page given its number. +# first page is number 1 +# +proc Rnotebook:raise {w num} { + global Rnotebook + if { ![string compare $num "current"] } { + set num $Rnotebook($w,current) + } + if { $num == 0 } { + set num 1 + } + if { $num != $Rnotebook($w,current) } { + pack forget $w.body.f$Rnotebook($w,current) + pack $w.body.f$num -fill both -expand 1 + } + set Rnotebook($w,current) $num + set bw $Rnotebook($w,bwidth) + + set x0 [expr [winfo x $w.tabs.b$num] + [winfo x $w.tabs] + $bw ] + set y0 [expr [winfo y $w.tabs.b$num] + [winfo y $w.tabs] + \ + [winfo height $w.tabs.b$num] - $bw] + set w0 [expr [winfo width $w.tabs.b$num] - ($bw * 2)] + set h0 [expr $bw * 2] + place $w.mask -x $x0 -y $y0 -width $w0 -height $h0 + + set x1 [expr $x0 - $bw] + set y1 $y0 + set w1 $bw + set h1 $h0 + place $w.mskl -x $x1 -y $y1 -width $w1 -height $h1 + + set x2 [expr $x0 + $w0] + set y2 $y0 + set w2 $bw + set h2 $h0 + place $w.mskr -x $x2 -y $y2 -width $w2 -height $h2 +} + +# +# Return the frame associated with a given page number +# +proc Rnotebook:frame {w num} { + global Rnotebook + set i "$w.body.f$num" + if [ winfo exists $i] { + return $i + } else { + return {} + } +} + +# +# Return the button associated with a given page number +# +proc Rnotebook:button {w num} { + global Rnotebook + set i "$w.tabs.b$num" + if [ winfo exists $i] { + return $i + } else { + return {} + } +} + + diff --git a/modules/tclsci/tcl/sciGUI/local_extra/spinbutton.tcl b/modules/tclsci/tcl/sciGUI/local_extra/spinbutton.tcl new file mode 100755 index 000000000..75feecb45 --- /dev/null +++ b/modules/tclsci/tcl/sciGUI/local_extra/spinbutton.tcl @@ -0,0 +1,316 @@ +# +# Spinbutton Widget +# by Waster +# +# Mail : waster@iname.com +# ICQ : 27216346 +# + +set spinbutton(win) "" + +# +# These four procedures are for +# disabling/enabling buttons +# +proc spinbutton:upenable {w} { +global spinbutton + set spinbutton($w,updisabled) 0 + $w.f.up delete all + $w.f.up create line 5 1 8 8 -fill #a0a0a0 + $w.f.up create line 5 1 9 8 -fill #000000 + $w.f.up create line 2 7 8 7 -fill #a0a0a0 + $w.f.up create line 2 8 5 2 -fill #e0e0e0 + $w.f.up create line 1 8 5 1 -fill #ffffff + $w.f.up create line 2 8 9 8 -fill #000000 + bind $w.f.up <Button-1> "set spinbutton($w,ptime) 1;set spinbutton($w,press) 1; spinbutton:uppress $w" + bind $w.f.up <ButtonRelease-1> "set spinbutton($w,press) 0; spinbutton:uprelease $w" +} + +proc spinbutton:updisable {w} { +global spinbutton + set spinbutton($w,updisabled) 1 + $w.f.up delete all + $w.f.up create line 5 1 9 8 -fill #606060 + $w.f.up create line 1 8 5 1 -fill #e0e0e0 + $w.f.up create line 2 8 9 8 -fill #606060 + bind $w.f.up <Button-1> "" + bind $w.f.up <ButtonRelease-1> "" +} + +proc spinbutton:downenable {w} { +global spinbutton + set spinbutton($w,downdisabled) 0 + $w.f.down delete all + $w.f.down create line 5 8 8 1 -fill #000000 + $w.f.down create line 5 8 9 1 -fill #000000 + $w.f.down create line 2 2 8 2 -fill #c0c0c0 + $w.f.down create line 2 1 5 7 -fill #e0e0e0 + $w.f.down create line 1 1 5 8 -fill #c0c0c0 + $w.f.down create line 2 1 9 1 -fill #e0e0e0 + bind $w.f.down <Button-1> "set spinbutton($w,ptime) 1; set spinbutton($w,press) -1; spinbutton:downpress $w" + bind $w.f.down <ButtonRelease-1> "set spinbutton($w,press) 0; spinbutton:downrelease $w" +} + +proc spinbutton:downdisable {w} { +global spinbutton + set spinbutton($w,downdisabled) 1 + $w.f.down delete all + $w.f.down create line 5 8 9 1 -fill #606060 + $w.f.down create line 1 1 5 8 -fill #e0e0e0 + $w.f.down create line 2 1 9 1 -fill #606060 + bind $w.f.down <Button-1> "" + bind $w.f.down <ButtonRelease-1> "" +} + +# +# This procedure is called whenever +# the user presses enter in the entry +# or a .path set ?var? command is called +# +proc spinbutton:pressenter {w} { +global spinbutton + set a [$w.ent get] + if {$a==""} {$w.ent insert end $spinbutton($w,val); return} + + set b [string index $a 0] + set a [string range $a 1 end] + + if {[string trim $b {0 1 2 3 4 5 6 7 8 9 - +}]!="" || [string trim $a {0 1 2 3 4 5 6 7 8 9}]!=""} { + $w.ent delete 0 end; $w.ent insert end $spinbutton($w,val); return} + + set a [expr $b$a] ;#We use this line to delete any existing +'s + + if {$spinbutton($w,max)!="" && $a>$spinbutton($w,max)} {set a $spinbutton($w,max)} + if {$spinbutton($w,min)!="" && $a<$spinbutton($w,min)} {set a $spinbutton($w,min)} + if {$a==$spinbutton($w,max)} {spinbutton:updisable $w} + if {$a==$spinbutton($w,min)} {spinbutton:downdisable $w} + if {$spinbutton($w,updisabled)==1 && $a<$spinbutton($w,max)} {spinbutton:upenable $w} + if {$spinbutton($w,downdisabled)==1 && $a>$spinbutton($w,min)} {spinbutton:downenable $w} + + set spinbutton($w,val) $a + $w.ent delete 0 end + $w.ent insert end $a + + eval $spinbutton($w,exec) +} + +# +# These four procedures are called whenever +# user presses one of the buttons +# +proc spinbutton:uppress {w} { +global spinbutton + if {$spinbutton($w,press)!="1"} {bind $w.f.up <Button-1> "set spinbutton($w,ptime) 1;set spinbutton($w,press) 1; spinbutton:uppress $w";return} + + if {$spinbutton($w,ptime)<="1"} { + $w.f.up delete all + $w.f.up create line 5 1 8 8 -fill #e0e0e0 + $w.f.up create line 5 1 9 8 -fill #ffffff + $w.f.up create line 2 7 8 7 -fill #e0e0e0 + $w.f.up create line 2 8 5 2 -fill #a0a0a0 + $w.f.up create line 1 8 5 1 -fill #000000 + $w.f.up create line 2 8 9 8 -fill #ffffff + } + + incr spinbutton($w,val) + $w.ent delete 0 end + $w.ent insert 0 $spinbutton($w,val) + + if {$spinbutton($w,downdisabled)==1 && $spinbutton($w,min)<$spinbutton($w,val)} {spinbutton:downenable $w} + if {$spinbutton($w,max)==$spinbutton($w,val)} {spinbutton:updisable $w; eval $spinbutton($w,exec); return} + + if {$spinbutton($w,ptime)==1} {bind $w.f.up <Button-1> ""; after 500 "spinbutton:uppress $w"} else {after 10 "spinbutton:uppress $w"} + incr spinbutton($w,ptime) + eval $spinbutton($w,exec) +} + +proc spinbutton:uprelease {w} { +global spinbutton + set spinbutton($w,press) 0 + $w.f.up delete all + $w.f.up create line 5 1 8 8 -fill #a0a0a0 + $w.f.up create line 5 1 9 8 -fill #000000 + $w.f.up create line 2 7 8 7 -fill #a0a0a0 + $w.f.up create line 2 8 5 2 -fill #e0e0e0 + $w.f.up create line 1 8 5 1 -fill #ffffff + $w.f.up create line 2 8 9 8 -fill #000000 +} + +proc spinbutton:downpress {w} { +global spinbutton + if {$spinbutton($w,press)!="-1"} {bind $w.f.down <Button-1> "set spinbutton($w,ptime) 1; set spinbutton($w,press) -1; spinbutton:downpress $w";return} + if {$spinbutton($w,ptime)<="1"} { + set wdown $w.f.down + $w.f.down delete all + $w.f.down create line 5 8 8 1 -fill #ffffff + $w.f.down create line 5 8 9 1 -fill #ffffff + $w.f.down create line 2 2 8 2 -fill #a0a0a0 + $w.f.down create line 2 1 5 7 -fill #000000 + $w.f.down create line 1 1 5 8 -fill #a0a0a0 + $w.f.down create line 2 1 9 1 -fill #000000 + } + set spinbutton($w,val) [expr $spinbutton($w,val)-1] + $w.ent delete 0 end + $w.ent insert 0 $spinbutton($w,val) + + if {$spinbutton($w,updisabled)==1 && $spinbutton($w,max)>$spinbutton($w,val)} {spinbutton:upenable $w} + if {$spinbutton($w,min)==$spinbutton($w,val)} {spinbutton:downdisable $w; eval $spinbutton($w,exec); return} + + if {$spinbutton($w,ptime)==1} {bind $w.f.down <Button-1> ""; after 500 "spinbutton:downpress $w";} else {after 10 "spinbutton:downpress $w"} + incr spinbutton($w,ptime) + eval $spinbutton($w,exec) +} + +proc spinbutton:downrelease {w} { +global spinbutton + set spinbutton($w,press) 0 + $w.f.down delete all + $w.f.down create line 5 8 8 1 -fill #000000 + $w.f.down create line 5 8 9 1 -fill #000000 + $w.f.down create line 2 2 8 2 -fill #c0c0c0 + $w.f.down create line 2 1 5 7 -fill #e0e0e0 + $w.f.down create line 1 1 5 8 -fill #c0c0c0 + $w.f.down create line 2 1 9 1 -fill #e0e0e0 +} + +# +# This procedure creates a new spinbutton widget +# +proc spinbutton {w args} { +global spinbutton + + if {[lsearch $spinbutton(win) $w]!=-1} {error "$w already exists"; return} + lappend spinbutton(win) $w + set spinbutton($w,val) 0 + set spinbutton($w,press) 0 ;#"-1" if down, "1" if up, "0" if none + set spinbutton($w,ptime) 1 + set spinbutton($w,updisabled) 0 + set spinbutton($w,downdisabled) 0 + set spinbutton($w,max) "" + set spinbutton($w,min) "" + set spinbutton($w,exec) "" + + frame $w + entry $w.ent -width 3 -justify right + $w.ent insert end 0 + frame $w.f + canvas $w.f.up -width 9 -height 9 -borderwidth 0 -highlightthickness 0 + canvas $w.f.down -width 9 -height 9 -borderwidth 0 -highlightthickness 0 + + pack $w.ent -side left -expand 1 -fill x + pack $w.f -side left + pack $w.f.up + pack $w.f.down + + $w.f.up create line 5 1 8 8 -fill #a0a0a0 + $w.f.up create line 5 1 9 8 -fill #000000 + $w.f.up create line 2 7 8 7 -fill #a0a0a0 + $w.f.up create line 2 8 5 2 -fill #e0e0e0 + $w.f.up create line 1 8 5 1 -fill #ffffff + $w.f.up create line 2 8 9 8 -fill #000000 + $w.f.down create line 5 8 8 1 -fill #000000 + $w.f.down create line 5 8 9 1 -fill #000000 + $w.f.down create line 2 2 8 2 -fill #c0c0c0 + $w.f.down create line 2 1 5 7 -fill #e0e0e0 + $w.f.down create line 1 1 5 8 -fill #c0c0c0 + $w.f.down create line 2 1 9 1 -fill #e0e0e0 + + bind $w.ent <Return> "spinbutton:pressenter $w" + bind $w.f.up <Button-1> "set spinbutton($w,ptime) 1;set spinbutton($w,press) 1;spinbutton:uppress $w" + bind $w.f.up <ButtonRelease-1> "set spinbutton($w,press) 0; set spinbutton($w,ptime) 1; set spinbutton($w,press) 0; spinbutton:uprelease $w" + bind $w.f.down <Button-1> "set spinbutton($w,ptime) 1;set spinbutton($w,press) -1;spinbutton:downpress $w" + bind $w.f.down <ButtonRelease-1> "set spinbutton($w,press) 0; set spinbutton($w,ptime) 1; set spinbutton($w,press) 0; spinbutton:downrelease $w" + + # We shouldn't leave any data behind us... + bind $w <Destroy> "spinbutton:destroy $w" + + spinbutton:createproc $w + eval $w configure $args +} + +proc spinbutton:destroy {w} { +global spinbutton +catch {rename spinbutton:$w ""} + set index [lsearch $spinbutton(win) $w] + set spinbutton(win) [lreplace $spinbutton(win) $index $index] + unset spinbutton($w,val) + unset spinbutton($w,press) + unset spinbutton($w,ptime) + unset spinbutton($w,updisabled) + unset spinbutton($w,downdisabled) + unset spinbutton($w,max) + unset spinbutton($w,min) + unset spinbutton($w,exec) +} + + + +# +# This procedure makes a command named $window +# (.n configure...) for the spinbutton +# +proc spinbutton:createproc {w} { +global spinbutton + + rename $w spinbutton:$w ;#We change the name of the window/frame (.n) to (spinbutton:.n) + + set start "\{" + set end "\}" + set prefix "set w $w\n" ;# Here we set the variable w to $w... $w will be automatically replaced because of the " chars + set main { #We start the procedure here... + global spinbutton + + switch -- $command { + get {return [$w.ent get]} + set {$w.ent delete 0 end; $w.ent insert 0 $args; spinbutton:pressenter $w} + configure { + foreach {tag value} $args { + switch -- $tag { + -limit {set min [lindex $value 0] + set max [lindex $value 1] + if {$max>=$min} {set spinbutton($w,max) $max + set spinbutton($w,min) $min + if {$spinbutton($w,val)<$min} {set spinbutton($w,val) $min; $w.ent delete 0 end; $w.ent insert end $min; spinbutton:downdisable $w} + if {$spinbutton($w,val)>$max} {set spinbutton($w,val) $max; $w.ent delete 0 end; $w.ent insert end $max; spinbutton:updisable $w} + } + } + -relief {eval spinbutton:$w configure -relief $value} + -borderwidth {eval spinbutton:$w configure -borderwidth $value; $w.ent configure -borderwidth $value} + -selectborderwidth {eval spinbutton:$w configure -selectborderwidth $value} + -highlightthickness {eval spinbutton:$w configure -highlighthickness $value} + -cursor {eval spinbutton:$w configure -cursor $value} + -width {eval $w.ent configure -width $value} + -justify {eval $w.ent configure -justify $value} + -takefocus {eval $w.ent configure -takefocus $value} + -insertontime {eval $w.ent configure -insertontime $value} + -insertofftime {eval $w.ent configure -insertofftime $value} + -insertbackground {eval $w.ent configure -insertbackground $value} + -foreground {eval $w.ent configure -foreground $value} + -font {eval $w.ent configure -font $value} + -background {eval spinbutton:$w configure -background $value} + -entbackground {eval $w.ent configure -background $value} + -highlightbackground {eval $w.ent configure -highlightbackground $value} + -highlightcolor {eval $w.ent configure -highlightcolor $value} + -exportselection {eval $w.ent configure -exportselection $value} + -selectforeground {eval $w.ent configure -selectforeground $value} + -selectbackground {eval $w.ent configure -selectbackground $value} + -insertwidth {eval $w.ent configure -insertwidth $value} + -insertborderwidth {eval $w.ent configure -insertborderwidth $value} + -execute {set spinbutton($w,exec) $value} + -state {if {$value=="disabled"} { + spinbutton:updisable $w + spinbutton:downdisable $w + $w.ent configure -state disabled} + if {$value=="normal"} { + $w.ent configure -state normal + $w set [$w get]}} + } + } + } + } + } ;#We finish the procedure + + eval proc $w {{command args}} $start$prefix$main$end + +} + diff --git a/modules/tclsci/tcl/sciGUI/sciBrowseVar.tcl b/modules/tclsci/tcl/sciGUI/sciBrowseVar.tcl new file mode 100755 index 000000000..f5f08ec02 --- /dev/null +++ b/modules/tclsci/tcl/sciGUI/sciBrowseVar.tcl @@ -0,0 +1,374 @@ +# sciBrowseVar.tcl +# Variable Browser +# This file is part of sciGUI toolbox +# Copyright (C) 2004 Jaime Urzua Grez +# mailto:jaime_urzua@yahoo.com +# rev. 0.2 - 2004/06/24 + +# ---------------------------------------------------------------------------- +# Function : sciGUIBrowseVarINI +# Parameters : +# Description : Initialice Variable Browse +# ---------------------------------------------------------------------------- +proc sciGUIBrowseVarINI { } { + global sciGUITable + set sciGUITable(browse,show) "1 2 4 5 6 8 10 15 16 17" + set sciGUITable(browse,chshow) 1 + set sciGUITable(browse,dshow) "" + set sciGUITable(browse,tnames) "{real or complex} polynomial boolean sparce {sparce boolean} integer {graphic handles} string {un-compiled func.} {function lib.} list tlist mlist pointer" + set sciGUITable(browse,tnumbe) {1 2 3 5 6 8 9 10 11 13 14 15 16 17 128} + set fid [open [file join $sciGUITable(internal,path) "tcl" "sciGUI" "data" "dontshow.txt"] r] + while { [eof $fid]==0 } { + gets $fid lineRead + set lineRead [string trimleft "$lineRead"] + lappend sciGUITable(browse,dshow) "$lineRead" + } + close $fid +} + + +# ---------------------------------------------------------------------------- +# Function : sciGUIBrowseVarFilterQuit +# Parameters : winId op +# Description : Destroy widget and keep the last configuration +# ---------------------------------------------------------------------------- +proc sciGUIBrowseVarFilterQuit { winId op } { + global sciGUITable + set sciGUITable(browse,show) "" + foreach q {1 2 4 5 6 8 9 10 11 13 14 15 16 17 128} { + if { $sciGUITable(win,$winId,data,bt$q) } { lappend sciGUITable(browse,show) $q } + unset sciGUITable(win,$winId,data,bt$q) + } + set cvar "[ [sciGUIName $winId].r.txt get 1.0 end ]" + set cvar [split "$cvar" "\n"] + set sciGUITable(browse,dshow) "" + foreach qwe $cvar { + if { $qwe!="" } { lappend sciGUITable(browse,dshow) "$qwe" } + } + sciGUIDestroy $winId +} + + +# ---------------------------------------------------------------------------- +# Function : sciGUIBrowseVarFilter +# Parameters : +# Description : Show filter widget +# ---------------------------------------------------------------------------- +proc sciGUIBrowseVarFilter {} { + global sciGUITable + set winId [sciGUICreate -1 "browsevarfilter"] + set w [sciGUIName $winId] + wm title $w "Scilab BrowseVar Filter ($winId)" + wm protocol $w WM_DELETE_WINDOW "sciGUIBrowseVarFilterQuit $winId 0" + wm resizable $w 0 0 + $w configure -background LightGray + frame $w.l -bd 2 -bg LightGray -relief ridge + frame $w.r -bd 2 -bg LightGray -relief ridge + grid config $w.l -column 0 -row 0 -columnspan 1 -rowspan 1 -sticky "n" + grid config $w.r -column 1 -row 0 -columnspan 1 -rowspan 1 -sticky "n" + label $w.l.btlab -text "Show:" -bg LightGray -fg blue + checkbutton $w.l.bt1 -text "real or complex" -bg LightGray -variable sciGUITable(win,$winId,data,bt1) -relief flat + checkbutton $w.l.bt2 -text "polynomial" -bg LightGray -variable sciGUITable(win,$winId,data,bt2) -relief flat + checkbutton $w.l.bt4 -text "boolean" -bg LightGray -variable sciGUITable(win,$winId,data,bt4) -relief flat + checkbutton $w.l.bt5 -text "sparce" -bg LightGray -variable sciGUITable(win,$winId,data,bt5) -relief flat + checkbutton $w.l.bt6 -text "sparce boolean" -bg LightGray -variable sciGUITable(win,$winId,data,bt6) -relief flat + checkbutton $w.l.bt8 -text "integer" -bg LightGray -variable sciGUITable(win,$winId,data,bt8) -relief flat + checkbutton $w.l.bt9 -text "graphic handles" -bg LightGray -variable sciGUITable(win,$winId,data,bt9) -relief flat + checkbutton $w.l.bt10 -text "string" -bg LightGray -variable sciGUITable(win,$winId,data,bt10) -relief flat + checkbutton $w.l.bt11 -text "un-compiled func." -bg LightGray -variable sciGUITable(win,$winId,data,bt11) -relief flat + checkbutton $w.l.bt13 -text "compiled func." -bg LightGray -variable sciGUITable(win,$winId,data,bt13) -relief flat + checkbutton $w.l.bt14 -text "function lib." -bg LightGray -variable sciGUITable(win,$winId,data,bt14) -relief flat + checkbutton $w.l.bt15 -text "list" -bg LightGray -variable sciGUITable(win,$winId,data,bt15) -relief flat + checkbutton $w.l.bt16 -text "tlist" -bg LightGray -variable sciGUITable(win,$winId,data,bt16) -relief flat + checkbutton $w.l.bt17 -text "mlist" -bg LightGray -variable sciGUITable(win,$winId,data,bt17) -relief flat + checkbutton $w.l.bt128 -text "pointer" -bg LightGray -variable sciGUITable(win,$winId,data,bt128) -relief flat + grid config $w.l.btlab -column 0 -row 0 -columnspan 1 -rowspan 1 -sticky "w" + set i 1 + foreach q {1 2 4 5 6 8 9 10 11 13 14 15 16 17 128 } { + set vl "deselect" + if { [lsearch $sciGUITable(browse,show) $q]>-1 } {set vl "select"} + $w.l.bt$q $vl + grid config $w.l.bt$q -column 0 -row $i -columnspan 1 -rowspan 1 -sticky "w" + incr i + } + checkbutton $w.r.lab -text "Don't show :" -bg LightGray -fg blue -variable sciGUITable(browse,chshow) -relief flat + pack $w.r.lab -side top + text $w.r.txt -width 25 -height 20 -wrap word -yscrollcommand "$w.r.sb set" + scrollbar $w.r.sb -command "$w.r.txt yview" + pack $w.r.txt $w.r.sb -side left -fill both -pady 4 + $w.r.txt delete 1.0 end + set sciGUITable(browse,dshow) [lsort $sciGUITable(browse,dshow)] + foreach wq $sciGUITable(browse,dshow) { $w.r.txt insert end "$wq\n" } + button $w.ok -text "Ok" -command "sciGUIBrowseVarFilterQuit $winId 1" -width 8 + button $w.cancel -text "Cancel" -command "sciGUIBrowseVarFilterQuit $winId 0" -width 8 + grid config $w.ok -column 0 -row 1 -columnspan 1 -rowspan 1 -sticky "w" + grid config $w.cancel -column 1 -row 1 -columnspan 1 -rowspan 1 -sticky "e" +} + + +# ---------------------------------------------------------------------------- +# Function : sciGUIBrowseVarDelete +# Parameters : winId +# Description : Delete a Scilab variable +# ---------------------------------------------------------------------------- +proc sciGUIBrowseVarDelete { winId } { + global sciGUITable + set var $sciGUITable(win,$winId,data,cVar) + if { $var > 0 } { + set varname $sciGUITable(win,$winId,data,$var,3) + set answer [sciGUIButtonDialog -1 "Do you really want to delete $varname?" "yes|no"] + if {$answer==1} { ScilabEval "clear $varname ;browsevar();" } + } +} + + +# ---------------------------------------------------------------------------- +# Function : sciGUIBrowseVarEdit +# Parameters : winId +# Description : Edit a Scilab Variable +# ---------------------------------------------------------------------------- +proc sciGUIBrowseVarEdit { winId } { + global sciGUITable + set var $sciGUITable(win,$winId,data,cVar) + if { $var > 0 } { + set varname $sciGUITable(win,$winId,data,$var,3) + ScilabEval "editvar $varname;" + } +} + +# ---------------------------------------------------------------------------- +# Function : sciGUIBrowseVarProcFile +# Parameters : winId +# Description : Read variable information +# ---------------------------------------------------------------------------- +proc sciGUIBrowseVarProcFile { winId } { + global sciGUITable + for { set j 1 } { $j<=$sciGUITable(win,$winId,data,nVar) } {incr j} { + foreach k {0 1 2 3} { + unset sciGUITable(win,$winId,data,$j,$k) + } + } + set sciGUITable(win,$winId,data,nVar) 0 + set sciGUITable(win,$winId,data,cVar) 0 + set filename [file join $sciGUITable(win,$winId,data,tmpPath) "browsevar.txt"] + set fid [open $filename r] + while { [eof $fid]==0 } { + gets $fid lineRead + set lineRead [string trimleft "$lineRead"] + if { [regexp "^<d>*" "$lineRead"] } { + incr sciGUITable(win,$winId,data,nVar) + set cvar $sciGUITable(win,$winId,data,nVar) + set lineRead [string range "$lineRead" 3 end] + foreach re {0 1 2 3} { + set sciGUITable(win,$winId,data,$cvar,$re) [lindex "$lineRead" $re] + } + } + if { [regexp "^<m>*" "$lineRead"] } { + set w "[sciGUIName $winId].bottom.msg" + set lineRead [string range "$lineRead" 3 end] + set using [lindex "$lineRead" 1] + set total [lindex "$lineRead" 0] + set pto [lindex "$lineRead" 2] + $w configure -text "You are using $using of $total ($pto%)" + } + } + close $fid +} + +# ---------------------------------------------------------------------------- +# Function : sciGUIBrowseVarDraw +# Parameters : winId +# Description : Display variable information +# ---------------------------------------------------------------------------- +proc sciGUIBrowseVarDraw { winId } { + global sciGUITable + set w "[sciGUIName $winId].center.cnv" + $w delete all + set p 1 + + #F.Leray + #Browse all the var. to know the max dimension. + + set y 1 + + set maxk2 [string length "$sciGUITable(win,$winId,data,$y,3)"] + set maxk3 [string length "$sciGUITable(win,$winId,data,$y,1)"] + set maxk5 [string length "$sciGUITable(win,$winId,data,$y,2)"] + +# puts "1ere fois" +# puts "maxk2 = $maxk2" +# puts "maxk3 = $maxk3" +# puts "maxk5 = $maxk5" +# puts "$sciGUITable(win,$winId,data,$y,3)" +# puts "$sciGUITable(win,$winId,data,$y,1)" +# puts "$sciGUITable(win,$winId,data,$y,2)" + + for {set y 2} {$y <= $sciGUITable(win,$winId,data,nVar)} {incr y} { + + set tmp_maxk2 [string length "$sciGUITable(win,$winId,data,$y,3)"] + if { $tmp_maxk2 > $maxk2 } { + set maxk2 $tmp_maxk2 + } + + set tmp_maxk3 [string length "$sciGUITable(win,$winId,data,$y,1)"] + if { $tmp_maxk3 > $maxk3 } { + set maxk3 $tmp_maxk3 + } + + set tmp_maxk5 [string length "$sciGUITable(win,$winId,data,$y,2)"] + if { $tmp_maxk5 > $maxk5 } { + set maxk5 $tmp_maxk5 + } + } + +# puts "AV x8+1 : " +# puts "maxk2 = $maxk2" +# puts "maxk3 = $maxk3" +# puts "maxk5 = $maxk5" + + set maxk2 [expr $maxk2*8+1] + set maxk3 [expr $maxk3*8+1] + set maxk5 [expr $maxk5*8+1] + +# puts "maxk2 = $maxk2" +# puts "maxk3 = $maxk3" +# puts "maxk5 = $maxk5" + +# puts "150 inter1 = [expr 22+$maxk2]" +# puts "250 inter2 = [expr 22+$maxk2+$maxk3+$maxk5]" +# puts "235 inter3 = [expr 22+$maxk2+$maxk3]" + + + for {set y 1} {$y <= $sciGUITable(win,$winId,data,nVar)} {incr y} { + set yL [expr $p*18+2] + if { $y==$sciGUITable(win,$winId,data,cVar) } { + set cco "red";set cbb "yellow" + } else { + set cco "black";set cbb "white" + } + switch $sciGUITable(win,$winId,data,$y,0) { + 1 {set iconName "tp01";set typNam "real or complex"} + 2 {set iconName "tp02";set typNam "polynomial"} + 4 {set iconName "tp04";set typNam "boolean"} + 5 {set iconName "tp05";set typNam "sparce"} + 6 {set iconName "tp06";set typNam "sparce boolean"} + 8 {set iconName "tp08";set typNam "integer"} + 9 {set iconName "tp00";set typNam "graphic handles"} + 10 {set iconName "tp10";set typNam "string"} + 11 {set iconName "tp00";set typNam "un-compiled func."} + 13 {set iconName "tp00";set typNam "compiled func."} + 14 {set iconName "tp00";set typNam "function lib."} + 15 {set iconName "tp15";set typNam "list"} + 16 {set iconName "tp16";set typNam "tlist"} + 17 {set iconName "tp17";set typNam "mlist"} + 128 {set iconName "tp00";set typNam "pointer"} + default {set iconName "tp00";set typNam "unknow"} + } + + set putvar 0 + if { [lsearch $sciGUITable(browse,show) $sciGUITable(win,$winId,data,$y,0)]>-1 } { set putvar 1 } + if { $sciGUITable(browse,chshow) } { + if { [lsearch $sciGUITable(browse,dshow) $sciGUITable(win,$winId,data,$y,3)]>-1 } { set putvar 0 } + } + + if { $putvar==1 } { + set k(0) [$w create rectangle 22 [expr $yL-9] 350 [expr $yL+9] -fill $cbb -outline $cbb] + set k(1) [$w create image 0 $yL -image sciGUITable(gif,$iconName) -anchor w] + set k(2) [$w create text 22 $yL -text "$sciGUITable(win,$winId,data,$y,3)" -anchor w -fill $cco] + set tmno "$sciGUITable(win,$winId,data,$y,1)" + set k(3) [$w create text [expr 22+$maxk2] $yL -text "$tmno" -anchor w -fill $cco] + set k(4) [$w create text [expr 22+$maxk2+$maxk3+$maxk5] $yL -text "$typNam" -anchor w -fill $cco] + set k(5) [$w create text [expr 22+$maxk2+$maxk3] $yL -text "$sciGUITable(win,$winId,data,$y,2)" -anchor w -fill $cco] + foreach op {0 1 2 4 5} { + $w bind $k($op) <1> "set sciGUITable(win,$winId,data,cVar) $y; sciGUIBrowseVarDraw $winId" + } + incr p + } + } + $w config -scrollregion [$w bbox all] +} + + + +# ---------------------------------------------------------------------------- +# Function : sciGUIBrowseVarQuit +# Parameters : winId +# Description : Destroy Variable Browser widget +# ---------------------------------------------------------------------------- +proc sciGUIBrowseVarQuit { winId } { + global sciGUITable + for {set cvar 1} {$cvar <= $sciGUITable(win,$winId,data,nVar)} {incr cvar} { + foreach re {0 1 2 3} { + unset sciGUITable(win,$winId,data,$cvar,$re) + } + } + unset sciGUITable(win,$winId,data,nVar) + unset sciGUITable(win,$winId,data,cVar) + unset sciGUITable(win,$winId,data,localrefresh) + unset sciGUITable(win,$winId,data,tmpPath) + sciGUIDestroy $winId +} + +# ---------------------------------------------------------------------------- +# Function : sciGUIBrowseVar +# Parameters : tmpPath +# Description : Variable browser GUI +# ---------------------------------------------------------------------------- +proc sciGUIBrowseVar { tmpPath } { + global sciGUITable + set create 1 + foreach winId $sciGUITable(win,id) { + if { [sciGUIGetType $winId]=="browsevar" } { set create 0; break; } + } + if { $create==1 } { + set winId [sciGUICreate -1 "browsevar"] + set w [sciGUIName $winId] + wm title $w "Scilab BrowseVar($winId)" + wm protocol $w WM_DELETE_WINDOW "sciGUIBrowseVarQuit $winId" + wm resizable $w 0 1 + $w configure -background white + frame $w.top -bd 0 -background white + label $w.top.logo -image sciGUITable(gif,scilab01) -bg white + label $w.top.mes01 -text "Variable Browser" -font $sciGUITable(font,1) -bg white + pack $w.top -expand 0 + pack $w.top.logo -side left + pack $w.top.mes01 -side right + frame $w.center -background white -bd 0 + + canvas $w.center.cnv -width 350 -height 100 -bg white -relief sunken -yscrollcommand "$w.center.sb set" + scrollbar $w.center.sb -command "$w.center.cnv yview" + pack $w.center.cnv $w.center.sb -side left -fill y -expand 1 -anchor w + + pack $w.center -side top -expand 1 -fill both + +# F.Leray 19.04.05 : add a canvas to have a scrollbar on x + frame $w.center2 -background white -bd 0 + canvas $w.center2.cnv2 -width 0 -height 0 -bg white -relief sunken -xscrollcommand "$w.center2.sb2 set" + scrollbar $w.center2.sb2 -command "$w.center.cnv xview" -orient horizontal + pack $w.center2.cnv2 $w.center2.sb2 -side left -fill x -expand 1 -anchor n + pack $w.center2 -side top -fill both + + frame $w.bottom -background LightGray -bd 2 -relief sunken + button $w.bottom.edit -width 25 -height 25 -image sciGUITable(icon,iconPencil) -command "sciGUIBrowseVarEdit $winId" + balloonhelp $w.bottom.edit "Edit variable" + button $w.bottom.delete -width 25 -height 25 -image sciGUITable(icon,iconTrash) -command "sciGUIBrowseVarDelete $winId" + balloonhelp $w.bottom.delete "Delete variable" + button $w.bottom.refresh -width 25 -height 25 -image sciGUITable(icon,iconReload) -command "ScilabEval browsevar()" + balloonhelp $w.bottom.refresh "Refresh table" + button $w.bottom.filter -width 25 -height 25 -image sciGUITable(icon,iconFilter) -command "sciGUIBrowseVarFilter" + balloonhelp $w.bottom.filter "Filter preferences" + button $w.bottom.quit -text "quit" + balloonhelp $w.bottom.quit "Quit" + label $w.bottom.msg -text "" -bg LightGray + pack $w.bottom.edit $w.bottom.delete $w.bottom.refresh $w.bottom.filter $w.bottom.msg -side left -expand 0 -padx 3 -pady 3 + pack $w.bottom -side top -fill x -expand 0 + set sciGUITable(win,$winId,data,nVar) 0 + set sciGUITable(win,$winId,data,cVar) 0 + set sciGUITable(win,$winId,data,localrefresh) "sciGUIBrowseVarDraw $winId" + } + set sciGUITable(win,$winId,data,tmpPath) "$tmpPath" + sciGUIBrowseVarProcFile $winId + sciGUIBrowseVarDraw $winId +} + + diff --git a/modules/tclsci/tcl/sciGUI/sciEditVar.tcl b/modules/tclsci/tcl/sciGUI/sciEditVar.tcl new file mode 100755 index 000000000..520323aed --- /dev/null +++ b/modules/tclsci/tcl/sciGUI/sciEditVar.tcl @@ -0,0 +1,699 @@ + + +set pwd [pwd] +cd [file dirname [info script]] +variable DEMODIR [pwd] +cd $pwd + +variable DEMODIR + +lappend ::auto_path [file dirname "$env(SCIPATH)/modules/tclsci/tcl/BWidget"] +namespace inscope :: package require BWidget +package require BWidget + + + + +# sciEditVar.tcl +# Implements a matrix editor +# This file is part of sciGUI toolbox +# Copyright (C) 2004 Jaime Urzua Grez +# mailto:jaime_urzua@yahoo.com +# rev. 0.1 + + +# ---------------------------------------------------------------------------- +# Function : sciGUIEditVarChangeColWidth +# Parameters : winId col +# Description : Change the column width +# ---------------------------------------------------------------------------- +proc sciGUIEditVarChangeColWidthDo { winId2 lastval winId col } { + global sciGUITable + sciGUIDestroy $winId2 + set newWidthCar $sciGUITable(win,$winId,data,cwc,$col) + set sciGUITable(win,$winId,data,cwc,$col) $newWidthCar + if { $sciGUITable(win,$winId,data,cwc,$col)!=$lastval } { + set w "[sciGUIName $winId].editor" + $w.editzone delete entryTag + $w.editzone create window -100 -100 -window $w.editzone.entry -anchor nw -tags entryTag + $w.editzone.entry configure -width $newWidthCar + set bb1 [$w.editzone bbox entryTag] + set deltaPixX [expr [lindex $bb1 2] - [lindex $bb1 0] + 2] + set widtCell [expr $sciGUITable(win,$winId,data,cwp,$col)-$sciGUITable(win,$winId,data,cwp,[expr $col-1])] + set deltaPixX2 [expr $deltaPixX-$widtCell] + for { set j $col } { $j<=$sciGUITable(win,$winId,data,nj) } { incr j } { + incr sciGUITable(win,$winId,data,cwp,$j) $deltaPixX2 + } + set w1 "[sciGUIName $winId].editor.editzone" + set w2 "[sciGUIName $winId].editor.jaxes" + for { set j $col } { $j<=$sciGUITable(win,$winId,data,nj) } { incr j } { + $w1 move col$j $deltaPixX2 0 + $w2 move colj$j $deltaPixX2 0 + $w2 move coltxt$j $deltaPixX2 0 + for { set i 1 } { $i <=$sciGUITable(win,$winId,data,ni) } { incr i } { + $w1 move item($i,$j) $deltaPixX2 0 + } + } + incr sciGUITable(win,$winId,data,jall) $deltaPixX2 + set jall $sciGUITable(win,$winId,data,jall) + set iall $sciGUITable(win,$winId,data,iall) + set di $sciGUITable(win,$winId,data,di) + + for { set i 0 } { $i<=$sciGUITable(win,$winId,data,ni) } { incr i } { + set qw [$w1 coords row$i] + set qw [lreplace $qw 2 2 $jall] + $w1 coords row$i $qw + } + set di $sciGUITable(win,$winId,data,di) + set x [expr $sciGUITable(win,$winId,data,cwp,$col) -3] + for { set i 1 } { $i<=$sciGUITable(win,$winId,data,ni) } { incr i } { + $w.editzone delete item($i,$col) + set y [expr ($i-0.5)*$di] + sciGUIEditVarPutCell $w.editzone $x $y "$sciGUITable(win,$winId,data,$i,$col)" $deltaPixX item($i,$col) $di + + } + + set qw [$w1 coords bground] + set qw [lreplace $qw 2 2 $jall] + $w1 coords bground $qw + $w1 config -scrollregion "0 0 $jall $iall" + $w2 config -scrollregion "0 0 $jall $di" + } +} +# ---------------------------------------------------------------------------- +# Function : sciGUIEditVarChangeColWidth +# Parameters : winId col +# Description : +# ---------------------------------------------------------------------------- +proc sciGUIEditVarChangeColWidth { winId col } { + global sciGUITable + set winId2 [sciGUICreate -1 "editvar_change_width" ] + set w [sciGUIName $winId2] + set lastval $sciGUITable(win,$winId,data,cwc,$col) + label $w.msg -text "Set new width for column $col:" + entry $w.nwid -textvariable sciGUITable(win,$winId,data,cwc,$col) -width 3 + button $w.apply -text "ok" -command "sciGUIEditVarChangeColWidthDo $winId2 $lastval $winId $col" + pack $w.msg $w.nwid $w.apply -side left -fill x + focus $w.nwid + #grab $w +} + + +# ---------------------------------------------------------------------------- +# Function : sciGUIEditVarReFreshX +# Parameters : winId c1 c2 c3 +# Description : +# ---------------------------------------------------------------------------- +proc sciGUIEditVarReFreshX { winId c1 c2 {c3 ""} } { + global sciGUITable + set w "[sciGUIName $winId].editor" + if { $c3!= "" } { + $w.editzone xview $c1 $c2 $c3 + $w.jaxes xview $c1 $c2 $c3 + } else { + $w.editzone xview $c1 $c2 + $w.jaxes xview $c1 $c2 + } +} + +# ---------------------------------------------------------------------------- +# Function : sciGUIEditVarReFreshY +# Parameters : winId c1 c2 c3 +# Description : +# ---------------------------------------------------------------------------- +proc sciGUIEditVarReFreshY { winId c1 c2 {c3 ""} } { + global sciGUITable + set w "[sciGUIName $winId].editor" + if { $c3!= "" } { + $w.editzone yview $c1 $c2 $c3 + $w.iaxes yview $c1 $c2 $c3 + } else { + $w.editzone yview $c1 $c2 + $w.iaxes yview $c1 $c2 + } +} + +# ---------------------------------------------------------------------------- +# Function : sciGUIEditVarPutCell +# Parameters : winName x y text wid tag +# Description : Try to fix +# ---------------------------------------------------------------------------- +proc sciGUIEditVarPutCell { winName x y txt wid tag di} { + set loctxt "$txt" + set ok 1 + set loccol black + while { $ok==1 } { + $winName create text $x $y -text "$loctxt" -anchor e -width $wid -tag $tag -fill $loccol + set bb [$winName bbox $tag] + set ldi [expr [lindex $bb 3] - [lindex $bb 1]] + if { $ldi>=$di } { + set loctxt [string range "$loctxt" 1 end] + $winName delete $tag + set loccol blue + } else { + set ok 0 + } + } +} + +# ---------------------------------------------------------------------------- +# Function : sciGUIEditVarUpdateScilab +# Parameters : winId +# Description : +# ---------------------------------------------------------------------------- +proc sciGUIEditVarUpdateScilab { winId } { + global sciGUITable + set newNbRow $sciGUITable(win,$winId,data,ni) + set newNbCol $sciGUITable(win,$winId,data,nj) + ScilabEval "$sciGUITable(win,$winId,data,name)=editvar_get($winId);" +} + + +# ---------------------------------------------------------------------------- +# Function : sciGUIEditVarDrawGrid +# Parameters : winId +# Description : +# ---------------------------------------------------------------------------- +proc sciGUIEditVarDrawGrid { winId } { + global sciGUITable + set w "[sciGUIName $winId].buttons.update" + $w configure -command "sciGUIEditVarUpdateScilab $winId" + set w "[sciGUIName $winId].buttons.msg1" + $w configure -text "editing variable -> $sciGUITable(win,$winId,data,name)" + set w "[sciGUIName $winId].editor" + set ni $sciGUITable(win,$winId,data,ni) + set nj $sciGUITable(win,$winId,data,nj) + set defw 350 + set defh 150 + set defcc 15 + + canvas $w.editzone -width $defw -height $defh -yscrollcommand "$w.sbi set" -xscrollcommand "$w.sbj set" + set k0 [entry $w.editzone.entry -width $defcc -bd 0 -relief flat -background yellow] + bind $k0 <Return> "sciGUIEditVarEditCellAdv $winId 1 0" + bind $k0 <Right> "sciGUIEditVarEditCellAdv $winId 0 1" + bind $k0 <Left> "sciGUIEditVarEditCellAdv $winId 0 -1" + bind $k0 <Up> "sciGUIEditVarEditCellAdv $winId -1 0" + bind $k0 <Down> "sciGUIEditVarEditCellAdv $winId 1 0" + + $w.editzone create window -100 -100 -window $w.editzone.entry -anchor nw -tags entryTag + set bb1 [$w.editzone bbox entryTag] + set dj [expr [lindex $bb1 2] - [lindex $bb1 0] + 2] + set dj2 [expr $dj/2] + set di [expr [lindex $bb1 3] - [lindex $bb1 1] + 2] + set di2 [expr $di/2] + set jall [expr $dj*$nj + 1 ] + set iall [expr $di*$ni + 1 ] + $w.editzone delete entryTag + set sciGUITable(win,$winId,data,jall) $jall + set sciGUITable(win,$winId,data,iall) $iall + set sciGUITable(win,$winId,data,di) $di + + $w.editzone create rectangle 0 0 $jall $iall -fill white -width 0 -tag bground + + canvas $w.jaxes -width $defw -height $di -xscrollcommand "$w.sbj set" + set sciGUITable(win,$winId,data,cwp,0) 0 + set sciGUITable(win,$winId,data,cwc,0) 0 + for { set j 1 } { $j<=$nj } { incr j } { + $w.jaxes create text [expr $j*$dj-3] $di2 -text $j -anchor e -tag coltxt$j + set sciGUITable(win,$winId,data,cwc,$j) $defcc + set sciGUITable(win,$winId,data,cwp,$j) [expr $dj*$j] + } + $w.jaxes config -scrollregion "0 0 $jall $di" + + canvas $w.iaxes -height $defh -yscrollcommand "$w.sbi set" + for { set i 1 } { $i<=$ni } { incr i } { + $w.iaxes create text 5 [expr ($i-0.5)*$di] -text $i -anchor w + } + set q [$w.iaxes bbox all] + set wi [expr [lindex $q 2] - [lindex $q 0] + 10 ] + $w.iaxes config -width $wi + $w.iaxes config -scrollregion "0 0 $wi $iall" + + scrollbar $w.sbj -orient horizontal -command "sciGUIEditVarReFreshX $winId" + scrollbar $w.sbi -orient vertical -command "sciGUIEditVarReFreshY $winId" + + grid config $w.jaxes -column 1 -row 0 -sticky "snew" + grid config $w.iaxes -column 0 -row 1 -sticky "snew" + grid config $w.editzone -column 1 -row 1 -sticky "snew" + grid config $w.sbi -column 2 -row 1 -sticky "snew" + grid config $w.sbj -column 1 -row 2 -sticky "snew" + grid columnconfigure $w 1 -weight 1 + grid rowconfigure $w 1 -weight 1 + + for { set i 1 } { $i<=$ni } { incr i } { + for { set j 1 } { $j<=$nj } { incr j } { + set y [expr ($i-0.5)*$di] + set x [expr $j*$dj-3] + sciGUIEditVarPutCell $w.editzone $x $y "$sciGUITable(win,$winId,data,$i,$j)" $dj item($i,$j) $di + } + } + + for { set i 0 } { $i<=$ni } { incr i } { + $w.editzone create line 0 [expr $i*$di] $jall [expr $i*$di] -tag row$i + } + + for { set j 0 } { $j<=$nj } { incr j } { + $w.editzone create line [expr $j*$dj] 0 [expr $j*$dj] $iall -tag col$j + $w.jaxes create line [expr $j*$dj] 0 [expr $j*$dj] $di -tag colj$j + $w.jaxes bind colj$j <Any-Enter> "$w.jaxes configure -cursor sb_h_double_arrow" + $w.jaxes bind colj$j <Any-Leave> "$w.jaxes configure -cursor arrow" + $w.jaxes bind colj$j <1> "sciGUIEditVarChangeColWidth $winId $j" + } + + set bb2 [$w.editzone bbox all] + $w.editzone config -scrollregion "0 0 $jall $iall" + + bind $w.editzone <1> "sciGUIEditVarEdit $winId %x %y" +} + +# ---------------------------------------------------------------------------- +# Function : sciGUIEditVarTrunc +# Parameters : n +# Description : +# ---------------------------------------------------------------------------- +proc sciGUIEditVarTrunc { n } { + set h [string first "." "$n" ] + incr h -1 + return [string range "$n" 0 $h] +} + + +# ---------------------------------------------------------------------------- +# Function : sciGUIEditVarEditCell +# Parameters : winId di dj +# Description : +# ---------------------------------------------------------------------------- +proc sciGUIEditVarEditCellAdv { winId di dj } { + global sciGUITable + set ci [expr $sciGUITable(win,$winId,data,last_i) + $di] + set cj [expr $sciGUITable(win,$winId,data,last_j) + $dj] + sciGUIEditVarEditCell $winId $ci $cj +} + +# ---------------------------------------------------------------------------- +# Function : sciGUIEditVarEditCell +# Parameters : winId ci cj +# Description : +# ---------------------------------------------------------------------------- +proc sciGUIEditVarEditCell { winId ci cj } { + global sciGUITable + set w "[sciGUIName $winId].buttons.msg2" + $w configure -text "cell -> ($ci,$cj)" + set w "[sciGUIName $winId].editor" + set di $sciGUITable(win,$winId,data,di) + if { $ci>=$sciGUITable(win,$winId,data,ni) } { set ci $sciGUITable(win,$winId,data,ni) } + if { $cj>=$sciGUITable(win,$winId,data,nj) } { set cj $sciGUITable(win,$winId,data,nj) } + if { $ci<=1 } { set ci 1 } + if { $cj<=1 } { set cj 1 } + set li $sciGUITable(win,$winId,data,last_i) + set lj $sciGUITable(win,$winId,data,last_j) + + if { $li>=0 & $lj>=0 } { + set xtarget [expr $sciGUITable(win,$winId,data,cwp,[expr $cj-1]) + 2] + set ytarget [expr ($ci-1)*$di+2] + $w.editzone create window $xtarget $ytarget -window $w.editzone.entry -anchor nw -tags entryTag + $w.editzone.entry configure -width $sciGUITable(win,$winId,data,cwc,$cj) + focus $w.editzone.entry + if { ($li*$lj)>0 } { + set sciGUITable(win,$winId,data,$li,$lj) [ $w.editzone.entry get ] + set dj [expr $sciGUITable(win,$winId,data,cwp,$lj) - $sciGUITable(win,$winId,data,cwp,[expr $lj-1])] + $w.editzone delete item($li,$lj) + set y [expr ($li-0.5)*$di] + set x [expr $sciGUITable(win,$winId,data,cwp,$lj)-3] + sciGUIEditVarPutCell $w.editzone $x $y "$sciGUITable(win,$winId,data,$li,$lj)" $dj item($li,$lj) $di + } + } + $w.editzone.entry delete 0 end + $w.editzone.entry insert end "$sciGUITable(win,$winId,data,$ci,$cj)" + set sciGUITable(win,$winId,data,last_i) $ci + set sciGUITable(win,$winId,data,last_j) $cj +} + + + +# ---------------------------------------------------------------------------- +# Function : sciGUIEditVarEdit +# Parameters : winId x y +# Description : +# ---------------------------------------------------------------------------- +proc sciGUIEditVarEdit { winId x y } { + global sciGUITable + + set w "[sciGUIName $winId].editor" + set jall $sciGUITable(win,$winId,data,jall) + set iall $sciGUITable(win,$winId,data,iall) + set ni $sciGUITable(win,$winId,data,ni) + set nj $sciGUITable(win,$winId,data,nj) + set di $sciGUITable(win,$winId,data,di) + set px [$w.editzone canvasx $x] + set py [$w.editzone canvasy $y] + if { $py<=$iall } { + set ci [sciGUIEditVarTrunc [expr $py/$di]] + incr ci + } else { + set ci -1 + } + + if { $px<=$jall } { + for {set j 0 } { $j<$nj } { incr j } { + if { $px>=$sciGUITable(win,$winId,data,cwp,$j) } { + if { $px<=$sciGUITable(win,$winId,data,cwp,[expr $j+1]) } { + set cj [expr $j+1] + break + } + } + } + } else { + set cj -1 + } + sciGUIEditVarEditCell $winId $ci $cj +} + + +# ---------------------------------------------------------------------------- +# Function : sciGUIEditVarQuit +# Parameters : winID +# Description : Quit editor +# ---------------------------------------------------------------------------- +proc sciGUIEditVarQuit { winId } { + global sciGUITable + unset sciGUITable(win,$winId,data,name) + unset sciGUITable(win,$winId,data,type) + unset sciGUITable(win,$winId,data,ni) + for { set j 0 } { $j<=$sciGUITable(win,$winId,data,nj) } { incr j } { + unset sciGUITable(win,$winId,data,cwp,$j) + unset sciGUITable(win,$winId,data,cwc,$j) + } + unset sciGUITable(win,$winId,data,nj) + unset sciGUITable(win,$winId,data,last_i) + unset sciGUITable(win,$winId,data,last_j) + sciGUIDestroy $winId + +} + +# ---------------------------------------------------------------------------- +# Function : sciGUIEditVar +# Parameters : winId filename +# Description : Matrix editor GUI +# ---------------------------------------------------------------------------- +proc sciGUIEditVar { {winId -1 } } { + global sciGUITable + set winId2 [sciGUICreate $winId "editvar" ] + # read the information + set sciGUITable(win,$winId2,data,last_i) 0 + set sciGUITable(win,$winId2,data,last_j) 0 + + set w [sciGUIName $winId2] + wm title $w "Scilab Edit Var ($winId2)" + wm protocol $w WM_DELETE_WINDOW "sciGUIEditVarQuit $winId2" + + $w configure -background white + frame $w.top -bd 0 -background white + label $w.top.logo -image sciGUITable(gif,scilab01) -bg white + label $w.top.mes01 -text "Edit Var" -font $sciGUITable(font,1) -bg white + pack $w.top -expand 0 + pack $w.top.logo -side left + pack $w.top.mes01 -side right + + frame $w.buttons -bd 1 -background LightGray + frame $w.editor -bd 3 -background LightGray -relief groove + + button $w.buttons.update -text "Update to Scilab" -width 10 + button $w.buttons.resize -text "Resize" -width 10 -command "sciGUIEditVarChangeMatrixSize $winId2" + button $w.buttons.quit -text "Quit" -width 10 -command "sciGUIEditVarQuit $winId2" + label $w.buttons.msg1 -text "Loading variable, please wait ..." -bg LightGray -fg blue + + label $w.buttons.msg2 -text "" -bg LightGray -fg blue + pack $w.buttons.update $w.buttons.resize $w.buttons.quit $w.buttons.msg1 $w.buttons.msg2 -side left -padx 4 -expand 0 -fill x -pady 2 + + pack $w.buttons -side top -expand 0 -fill x + pack $w.editor -side top -expand 1 -fill both + + return $winId2 +} + + + +### FOR TEST ONLY +set TEST 0 +if { $TEST==1 } { + source sciGUI.tcl + sciGUIDoInit "d:/sciGUI" + set winId [sciGUIEditVar -1] + set sciGUITable(win,$winId,data,name) "test" + set sciGUITable(win,$winId,data,type) 1 + set sciGUITable(win,$winId,data,ni) 10 + set sciGUITable(win,$winId,data,nj) 10 + for { set i 1 } { $i<=$sciGUITable(win,$winId,data,ni) } { incr i } { + for { set j 1 } { $j<=$sciGUITable(win,$winId,data,nj) } { incr j } { + set sciGUITable(win,$winId,data,$i,$j) [expr $i*$j] + } + } + sciGUIEditVarDrawGrid $winId +} + + + + + + + + + + + + + + + + + + + +# ---------------------------------------------------------------------------- +# Function : sciGUIEditVar +# Parameters : winId filename +# Description : Matrix editor GUI +# ---------------------------------------------------------------------------- +proc GEDsciGUIEditVar { {winId -1 } } { + global sciGUITable + set winId2 [sciGUICreate $winId "editvar" ] + # read the information + set sciGUITable(win,$winId2,data,last_i) 0 + set sciGUITable(win,$winId2,data,last_j) 0 + + set w [sciGUIName $winId2] + wm title $w "Scilab Edit Var ($winId2)" + wm protocol $w WM_DELETE_WINDOW "sciGUIEditVarQuit $winId2" + #F.Leray + wm geometry $w 420x320 + + # I will now force this window to be always on top while not closed. + wm withdraw $w + update idletasks +# wm transient $www $w + wm deiconify $w + grab set $w + + + + $w configure -background white + frame $w.top -bd 0 -background white + label $w.top.logo -image sciGUITable(gif,scilab01) -bg white + label $w.top.mes01 -text "Edit Var" -font $sciGUITable(font,1) -bg white + pack $w.top -expand 0 + pack $w.top.logo -side left + pack $w.top.mes01 -side right + + frame $w.buttons -bd 1 -background LightGray + frame $w.editor -bd 3 -background LightGray -relief groove + + button $w.buttons.quit -text "Refresh !" -command "CloseEditorSaveData $winId2" + label $w.buttons.msg1 -text "Please wait: loading data... " -bg LightGray -fg blue + label $w.buttons.msg2 -text "" -bg LightGray -fg blue + pack $w.buttons.quit $w.buttons.msg1 $w.buttons.msg2 -side left -padx 4 -expand 1 -fill x -pady 2 + + pack $w.buttons -side top -expand 0 -fill x + pack $w.editor -side top -expand 1 -fill both + + return $winId2 +} + + + +# ---------------------------------------------------------------------------- +# Function : sciGUIEditVarDrawGrid +# Parameters : winId +# Description : +# ---------------------------------------------------------------------------- +#proc GEDsciGUIEditVarDrawGrid { winId winWB} { +proc GEDsciGUIEditVarDrawGrid { winId } { + global sciGUITable + + set w "[sciGUIName $winId].buttons.msg1" + $w configure -text "loading...." + set w "[sciGUIName $winId].editor" + set ni $sciGUITable(win,$winId,data,ni) + set nj $sciGUITable(win,$winId,data,nj) + set defw 350 + set defh 350 + set defcc 15 + + canvas $w.editzone -width $defw -height $defh -yscrollcommand "$w.sbi set" -xscrollcommand "$w.sbj set" + set k0 [entry $w.editzone.entry -width $defcc -bd 0 -relief flat -background yellow] + bind $k0 <Return> "sciGUIEditVarEditCellAdv $winId 1 0" + bind $k0 <Right> "sciGUIEditVarEditCellAdv $winId 0 1" + bind $k0 <Left> "sciGUIEditVarEditCellAdv $winId 0 -1" + bind $k0 <Up> "sciGUIEditVarEditCellAdv $winId -1 0" + bind $k0 <Down> "sciGUIEditVarEditCellAdv $winId 1 0" + + $w.editzone create window -100 -100 -window $w.editzone.entry -anchor nw -tags entryTag + set bb1 [$w.editzone bbox entryTag] + set dj [expr [lindex $bb1 2] - [lindex $bb1 0] + 2] + set dj2 [expr $dj/2] + set di [expr [lindex $bb1 3] - [lindex $bb1 1] + 2] + set di2 [expr $di/2] + set jall [expr $dj*$nj + 1 ] + set iall [expr $di*$ni + 1 ] + $w.editzone delete entryTag + set sciGUITable(win,$winId,data,jall) $jall + set sciGUITable(win,$winId,data,iall) $iall + set sciGUITable(win,$winId,data,di) $di + + $w.editzone create rectangle 0 0 $jall $iall -fill white -width 0 -tag bground + + canvas $w.jaxes -width $defw -height $di -xscrollcommand "$w.sbj set" + set sciGUITable(win,$winId,data,cwp,0) 0 + set sciGUITable(win,$winId,data,cwc,0) 0 + for { set j 1 } { $j<=$nj } { incr j } { + $w.jaxes create text [expr $j*$dj-3] $di2 -text $j -anchor e -tag coltxt$j + set sciGUITable(win,$winId,data,cwc,$j) $defcc + set sciGUITable(win,$winId,data,cwp,$j) [expr $dj*$j] + } + $w.jaxes config -scrollregion "0 0 $jall $di" + + canvas $w.iaxes -height $defh -yscrollcommand "$w.sbi set" + for { set i 1 } { $i<=$ni } { incr i } { + $w.iaxes create text 5 [expr ($i-0.5)*$di] -text $i -anchor w + } + set q [$w.iaxes bbox all] + set wi [expr [lindex $q 2] - [lindex $q 0] + 10 ] + $w.iaxes config -width $wi + $w.iaxes config -scrollregion "0 0 $wi $iall" + + scrollbar $w.sbj -orient horizontal -command "sciGUIEditVarReFreshX $winId" + scrollbar $w.sbi -orient vertical -command "sciGUIEditVarReFreshY $winId" + + grid config $w.jaxes -column 1 -row 0 -sticky "snew" + grid config $w.iaxes -column 0 -row 1 -sticky "snew" + grid config $w.editzone -column 1 -row 1 -sticky "snew" + grid config $w.sbi -column 2 -row 1 -sticky "snew" + grid config $w.sbj -column 1 -row 2 -sticky "snew" + grid columnconfigure $w 1 -weight 1 + grid rowconfigure $w 1 -weight 1 + + for { set i 1 } { $i<=$ni } { incr i } { + for { set j 1 } { $j<=$nj } { incr j } { + set y [expr ($i-0.5)*$di] + set x [expr $j*$dj-3] + sciGUIEditVarPutCell $w.editzone $x $y "$sciGUITable(win,$winId,data,$i,$j)" $dj item($i,$j) $di + } + } + + for { set i 0 } { $i<=$ni } { incr i } { + $w.editzone create line 0 [expr $i*$di] $jall [expr $i*$di] -tag row$i + } + + for { set j 0 } { $j<=$nj } { incr j } { + $w.editzone create line [expr $j*$dj] 0 [expr $j*$dj] $iall -tag col$j + $w.jaxes create line [expr $j*$dj] 0 [expr $j*$dj] $di -tag colj$j + $w.jaxes bind colj$j <Any-Enter> "$w.jaxes configure -cursor sb_h_double_arrow" + $w.jaxes bind colj$j <Any-Leave> "$w.jaxes configure -cursor arrow" + $w.jaxes bind colj$j <1> "sciGUIEditVarChangeColWidth $winId $j" + } + + set bb2 [$w.editzone bbox all] + $w.editzone config -scrollregion "0 0 $jall $iall" + + bind $w.editzone <1> "sciGUIEditVarEdit $winId %x %y" +} + + +proc CloseEditorSaveData { winId } { + ScilabEval "CloseEditorSaveData()" "seq" + ScilabEval "TCL_EvalStr(\"sciGUIEditVarQuit \"+\"$winId\")" "seq" + +} + +# ---------------------------------------------------------------------------- +# Function : sciGUIEditVarChangeMatrixSize +# Parameters : winId +# Description : Display a dialog box to enter a new size for the matrix +# ---------------------------------------------------------------------------- +proc sciGUIEditVarChangeMatrixSize { winId } { + global sciGUITable + set winId2 [sciGUICreate -1 "editvar_change_size" ] + set w [sciGUIName $winId2] + set ni $sciGUITable(win,$winId,data,ni) + set nj $sciGUITable(win,$winId,data,nj) + + frame $w.row -bd 1 + frame $w.column -bd 1 + frame $w.ok -bd 1 + + label $w.row.msg -text "Set number of row :" + entry $w.row.nwid -textvariable sciGUITable(win,$winId,data,ni) -width 4 + + label $w.column.msg -text "Set number of column :" + entry $w.column.nwid -textvariable sciGUITable(win,$winId,data,nj) -width 4 + + pack $w.row.msg $w.column.msg -side left -padx 4 -expand 0 -fill x -pady 2 + pack $w.row.nwid $w.column.nwid -side right -padx 4 -expand 0 -fill x -pady 2 + + button $w.apply -text "OK" -command "sciGUIEditVarSetMatrixSize $winId $winId2 $ni $nj" + pack $w.apply -side bottom -pady 2 + + pack $w.row $w.column -side top -fill x -pady 2 + #focus $w.row.nwid +} + +# ---------------------------------------------------------------------------- +# Function : sciGUIEditVarSetMatrixSize +# Parameters : winId +# Description : modify the matrix size +# ---------------------------------------------------------------------------- +proc sciGUIEditVarSetMatrixSize { winId winId2 oldNbRow oldNbCol} { + global sciGUITable + sciGUIDestroy $winId2 + + set newNbRow $sciGUITable(win,$winId,data,ni) + set newNbCol $sciGUITable(win,$winId,data,nj) + + ScilabEval "$sciGUITable(win,$winId,data,name)=resize_matrix($sciGUITable(win,$winId,data,name),$newNbRow,$newNbCol,'$sciGUITable(win,$winId,data,type)');" "seq" + + # Increase number of rows in table if needed + if { $oldNbRow < $newNbRow } { + for { set i [expr $oldNbRow+1] } { $i<=$newNbRow } { incr i } { + for { set j 0 } { $j<=$newNbCol } { incr j } { + set sciGUITable(win,$winId,data,$i,$j) "0" + } + } + } + # Increase number of cols in table if needed + if { $oldNbCol < $newNbCol } { + for { set j [expr $oldNbCol+1] } { $j<=$newNbCol } { incr j } { + for { set i 0 } { $i<=$newNbRow } { incr i } { + set sciGUITable(win,$winId,data,$i,$j) "0" + } + } + } + + set w "[sciGUIName $winId].editor" + destroy $w.editzone + destroy $w.jaxes + destroy $w.iaxes + destroy $w.sbj + destroy $w.sbi + + sciGUIEditVarDrawGrid $winId +} diff --git a/modules/tclsci/tcl/sciGUI/sciGUI.tcl b/modules/tclsci/tcl/sciGUI/sciGUI.tcl new file mode 100755 index 000000000..076419726 --- /dev/null +++ b/modules/tclsci/tcl/sciGUI/sciGUI.tcl @@ -0,0 +1,204 @@ +# sciGUI.tcl +# Main TK/TCL +# This file is part of sciGUI toolbox +# Copyright (C) 2004 Jaime Urzua Grez +# mailto:jaime_urzua@yahoo.com +# rev. 0.1 - 2004/06/13 + +# ---------------------------------------------------------------------------- +# Initial declarations and global variables +# ---------------------------------------------------------------------------- +global sciGUITable +global tcl_platform + + +# ---------------------------------------------------------------------------- +# Function : sciGUIGenFileName +# Parameters : +# Description : Return an incremental filename +# ---------------------------------------------------------------------------- +proc sciGUIGenFileName { } { + global sciGUITable + incr sciGUITable(internal,gname) + return "sciGUI_$sciGUITable(internal,gname).txt" +} + + +# ---------------------------------------------------------------------------- +# Function : sciGUILoadExtra +# Parameters : +# Description : Load external libs +# ---------------------------------------------------------------------------- +proc sciGUILoadExtra { } { + global sciGUITable + global tcl_platform + global auto_path + set ff [file join $sciGUITable(internal,path) "tcl" "sciGUI" "local_extra"] + # Balloonn help + source [file join $ff "balloonhelp.tcl"] + # Notebook + source [file join $ff "rnotebook.tcl"] + # Spin button + source [file join $ff "spinbutton.tcl"] + # Combo Box + source [file join $ff "combobox-2.3" "combobox.tcl"] +} + + +# ---------------------------------------------------------------------------- +# Function : sciGUIDOInit +# Parameters : path +# Description : Initialice Tk/Tcl sciGUI core +# ---------------------------------------------------------------------------- +proc sciGUIDoInit { {path ""} } { + global sciGUITable + global tcl_platform + set sciGUITable(internal,gname) 0 + set sciGUITable(internal,path) $path + set sciGUITable(win,id) 0 + set sciGUITable(win,0,type) "null" + set sciGUITable(icon,name) "" + set sciGUITable(font,1) {-*-helvetica-bold-r-*-*-24} + set sciGUITable(font,2) {-*-helvetica-normal-r-*-*-10} + sciGUIIconLoad + sciGUIGifLoad + sciGUILoadExtra + return 1 +} + +# ---------------------------------------------------------------------------- +# Function : sciGUIGetType +# Parameters : winId +# Description : Return type of window +# ---------------------------------------------------------------------------- +proc sciGUIGetType { winId } { + global sciGUITable + set pos [lsearch $sciGUITable(win,id) $winId] + set rt "" + if {$pos!=-1} { + set rt "$sciGUITable(win,$winId,type)" + } + return $rt +} + + +# ---------------------------------------------------------------------------- +# Function : sciGUIName +# Parameters : winId +# Description : Return window name +# ---------------------------------------------------------------------------- +proc sciGUIName { winId } { + return ".sciGUIwin$winId" +} + + +# ---------------------------------------------------------------------------- +# Function : sciGUIDestroy +# Parameters : winId +# Description : Destroy window and basic information asociated +# ---------------------------------------------------------------------------- +proc sciGUIDestroy { winId } { + global sciGUITable + if { [sciGUIExist $winId]==1 } { + destroy [sciGUIName $winId] + set ind [lsearch $sciGUITable(win,id) $winId] + set sciGUITable(win,id) [lreplace $sciGUITable(win,id) $ind $ind] + unset sciGUITable(win,$winId,type) + unset sciGUITable(win,$winId,data) + } + return $winId +} + + +# ---------------------------------------------------------------------------- +# Function : sciGUICreate +# Parameters : winId type wdestroy +# Description : Create windows +# ---------------------------------------------------------------------------- +proc sciGUICreate { {winId -1} {type "none"} } { + global sciGUITable + set winId2 $winId + if { $winId == -1 } { + set winId2 [lindex $sciGUITable(win,id) end] + set pass 1 + while { $pass==1 } { + set pass [sciGUIExist $winId2] + if { $pass==1 } { incr winId2 } + } + } + set wname [sciGUIName $winId2] + catch { destroy $wname } + toplevel $wname + wm title $wname "" + lappend sciGUITable(win,id) $winId2 + set sciGUITable(win,$winId2,type) $type + set sciGUITable(win,$winId2,data) "" + return $winId2 +} + + +# ---------------------------------------------------------------------------- +# Function : sciGUIExist +# Parameters : winId +# Description : Retur 1 if window exist, else 0 +# ---------------------------------------------------------------------------- +proc sciGUIExist { winId } { + global sciGUITable + set exist [lsearch $sciGUITable(win,id) $winId] + set output 0 + if { $exist > -1 } { set output 1 } + return $output +} + + +# ---------------------------------------------------------------------------- +# Function : sciGUIGifLoad +# Parameters : +# Description : Load initial gif files +# ---------------------------------------------------------------------------- +proc sciGUIGifLoad { } { + global sciGUITable + set fid [open [file join $sciGUITable(internal,path) "tcl" "sciGUI" "data" "giftable.txt"] r] + while { [eof $fid]==0 } { + gets $fid lineRead + set lineRead [string trimleft $lineRead] + set li [string first ":" "$lineRead"] + if { $li>-1 } { + #set pos [llength $sciGUITable(icon,name)] + set nam [string range "$lineRead" 0 [expr $li-1]] + set lfile [string range "$lineRead" [expr $li+1] end] + if { [string first "#" "$nam"] < 0 } { + set filename [file join $sciGUITable(internal,path) "tcl" "sciGUI" "data" $lfile] + image create photo sciGUITable(gif,$nam) -file $filename + } + } + + } + close $fid +} + + +# ---------------------------------------------------------------------------- +# Function : sciGUIIconLoad +# Parameters : +# Description : Load initial icons +# ---------------------------------------------------------------------------- +proc sciGUIIconLoad { } { + global sciGUITable + set fid [open [file join $sciGUITable(internal,path) "tcl" "sciGUI" "data" "icontable.txt"] r] + while { [eof $fid]==0 } { + gets $fid lineRead + set lineRead [string trimleft $lineRead] + set li [string first ":" "$lineRead"] + if { $li>-1 } { + set pos [llength $sciGUITable(icon,name)] + set nam [string range "$lineRead" 0 [expr $li-1]] + lappend sciGUITable(icon,name) $nam + set sciGUITable(icon,$pos) [string range "$lineRead" [expr $li+1] end] + image create photo sciGUITable(icon,$nam) -data $sciGUITable(icon,$pos) + } + } + close $fid +} + + |
