astk-1.13.1/0000755004705000470430000000000012161053525013015 5ustar courtoisasterdevastk-1.13.1/ASTK_CLIENT/0000755004705000470430000000000012161053525014615 5ustar courtoisasterdevastk-1.13.1/ASTK_CLIENT/bin/0000755004705000470430000000000012161053525015365 5ustar courtoisasterdevastk-1.13.1/ASTK_CLIENT/bin/astk0000755004705000470430000000266512161053524016265 0ustar courtoisasterdev#!?SHELL_EXECUTION? # ============================================================================== # COPYRIGHT (C) 1991 - 2003 EDF R&D WWW.CODE-ASTER.ORG # 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 EDF R&D CODE_ASTER, # 1 AVENUE DU GENERAL DE GAULLE, 92141 CLAMART CEDEX, FRANCE. # ============================================================================== set_prefix() { local this=`readlink -n -f $1` local bin=`dirname $this` prefix=`dirname $bin` } set_prefix $0 ASTER_ROOT=$prefix ASTER_ETC=$ASTER_ROOT/etc if [ "$ASTER_ROOT" = "/usr" ]; then ASTER_ETC=/etc fi export ASTER_ROOT export ASTER_ETC # set environment if [ -f $ASTER_ETC/codeaster/profile.sh ]; then . $ASTER_ETC/codeaster/profile.sh fi # start tcl/tk interpreter if [ -z "$WISHEXECUTABLE" ]; then WISHEXECUTABLE=wish fi $WISHEXECUTABLE $ASTER_ROOT/lib/astk/astk.tcl -- $* & astk-1.13.1/ASTK_CLIENT/bin/bsf0000755004705000470430000000266412161053524016074 0ustar courtoisasterdev#!?SHELL_EXECUTION? # ============================================================================== # COPYRIGHT (C) 1991 - 2003 EDF R&D WWW.CODE-ASTER.ORG # 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 EDF R&D CODE_ASTER, # 1 AVENUE DU GENERAL DE GAULLE, 92141 CLAMART CEDEX, FRANCE. # ============================================================================== set_prefix() { local this=`readlink -n -f $1` local bin=`dirname $this` prefix=`dirname $bin` } set_prefix $0 ASTER_ROOT=$prefix ASTER_ETC=$ASTER_ROOT/etc if [ "$ASTER_ROOT" = "/usr" ]; then ASTER_ETC=/etc fi export ASTER_ROOT export ASTER_ETC # set environment if [ -f $ASTER_ETC/codeaster/profile.sh ]; then . $ASTER_ETC/codeaster/profile.sh fi # start tcl/tk interpreter if [ -z "$WISHEXECUTABLE" ]; then WISHEXECUTABLE=wish fi $WISHEXECUTABLE $ASTER_ROOT/lib/astk/bsf.tcl -- $* & astk-1.13.1/ASTK_CLIENT/etc/0000755004705000470430000000000012161053525015370 5ustar courtoisasterdevastk-1.13.1/ASTK_CLIENT/etc/astkrc/0000755004705000470430000000000012161053525016657 5ustar courtoisasterdevastk-1.13.1/ASTK_CLIENT/etc/astkrc/ASTKRC_INFO.txt0000644004705000470430000000046112161053524021222 0ustar courtoisasterdev$Id: ASTKRC_INFO.txt 482 2003-08-05 06:31:44Z mcourtoi $ This directory contains : - outils ) to initialize the tools configuration at the first startup - config_serveurs ) to initialize the servers configuration at the first startup - prefs ) default values for user's preferences astk-1.13.1/ASTK_CLIENT/etc/astkrc/config_serveurs0000644004705000470430000000035612161053524022010 0ustar courtoisasterdev# serveur : ?SERVER_NAME? nom_complet : ?FULL_SERVER_NAME? login : username home : _VIDE etat : on rep_serv : ?ASTER_ROOT? recup : auto last_recup : 01/01/2000 xterm : ?TERMINAL? -sb -si -geometry 90x32 editeur : ?EDITOR? islocal : oui # astk-1.13.1/ASTK_CLIENT/etc/astkrc/outils0000644004705000470430000000065112161053524020122 0ustar courtoisasterdev# Tools configuration (used at first startup for each user) # $Id: outils 2551 2006-12-07 11:33:42Z courtois $ # astkrc_version : 1.1 # nom : Eficas cmde : ?TOOLS_DIR?/eficas (@F) ext : comm com0 com1 com2 dist : on # nom : Gmsh cmde : ?TOOLS_DIR?/gmsh (@F) ext : geo msh pos dist : on # nom : Gibi cmde : ?TOOLS_DIR?/gibi.x (@F) ext : datg dgibi dist : on # nom : Grace cmde : ?TOOLS_DIR?/xmgrace (@F) ext : dat dist : on # astk-1.13.1/ASTK_CLIENT/etc/astkrc/prefs0000644004705000470430000000055612161053524017726 0ustar courtoisasterdevnom_user : _VIDE email : _VIDE def_vers : ?ASTER_VERSION? xterm : ?TERMINAL? editeur : ?EDITOR? nb_reman : 6 langue : ENG dbglevel : 3 freq_actu : 3 nb_ligne : 20 nom_domaine : ?DOMAIN_NAME? # # Following values are not used by codeaster-gui (astk) # but may be useful to as_run. # (this replace the old ~/.astkrc/config file) # editor : ?EDITOR? devel_server_user :astk-1.13.1/ASTK_CLIENT/lib/0000755004705000470430000000000012161053525015363 5ustar courtoisasterdevastk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/0000755004705000470430000000000012161053525017351 5ustar courtoisasterdevastk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/images/0000755004705000470430000000000012161053525020616 5ustar courtoisasterdevastk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/images/bold.gif0000644004705000470430000000016612161053524022227 0ustar courtoisasterdevGIF89a!,#0I8[;ϝ^}YyꊶS8S,|O;astk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/images/copy.gif0000644004705000470430000000022112161053524022251 0ustar courtoisasterdevGIF89a!,>PI8[ &u_,yN)q0CӑpLǨ`}R-LV";astk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/images/cut.gif0000644004705000470430000000020212161053524022071 0ustar courtoisasterdevGIF89a!,/PI[E^fș*NmK/H k=a;astk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/images/dragfile.gif0000644004705000470430000000166512161053524023071 0ustar courtoisasterdevGIF89a  !!!"""###$$$%%%&&&'''((()))***+++,,,---...///000111222333444555666777888999:::;;;<<<===>>>???@@@AAABBBCCCDDDEEEFFFGGGHHHIIIJJJKKKLLLMMMNNNOOOPPPQQQRRRSSSTTTUUUVVVWWWXXXYYYZZZ[[[\\\]]]^^^___```aaabbbcccdddeeefffggghhhiiijjjkkklllmmmnnnooopppqqqrrrssstttuuuvvvwwwxxxyyyzzz{{{|||}}}~~~!,H*Çg0D^bF9ZD\ɲ!/c$ 1Mf L9x3hJH9QHy*}ԩΨ;2U(֬ 俯=R%vٯeƕOxބ-V@;astk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/images/dragicon.gif0000644004705000470430000000176412161053524023102 0ustar courtoisasterdevGIF89a3f3333ffff33!,H*Ç , 0D^bF9ZtI zI 0Ȇ/KlO7Tၣ2yRS)UҤ F5JaW>5i @}Tb .}vlp] 1 KpAŋ~ 9rcw+畜mϠ7_3錦OCKװi.Iτ;astk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/images/error.gif0000644004705000470430000000040312161053524022432 0ustar courtoisasterdevGIF89a 1!, PI'`b] ( Օƞp=v>À"،*'EhšHOB@kt0"m*(V\ӊ{Gs6{rstR/o~q}PX i^x1KYGu]?/dCIC|@:v.,ĸ%β;astk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/images/file.gif0000644004705000470430000000153412161053524022226 0ustar courtoisasterdevGIF89a   !!!"""###$$$%%%&&&'''((()))***+++,,,---...///000111222333444555666777888999:::;;;<<<===>>>???@@@AAABBBCCCDDDEEEFFFGGGHHHIIIJJJKKKLLLMMMNNNOOOPPPQQQRRRSSSTTTUUUVVVWWWXXXYYYZZZ[[[\\\]]]^^^___```aaabbbcccdddeeefffggghhhiiijjjkkklllmmmnnnooopppqqqrrrssstttuuuvvvwwwxxxyyyzzz{{{|||}}}~~~!, 9U HP C>T0CU %^xP"7KcƐ&GZ 2$K$;astk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/images/folder.gif0000644004705000470430000000021312161053524022553 0ustar courtoisasterdevGIF89a !, 8@1ٵuWYi)so]`~H#'X@Z;astk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/images/hourglass.gif0000644004705000470430000000032312161053524023311 0ustar courtoisasterdevGIF89a ! , pI8ͻ`disI,*`8"B'~JbP ].x@[[ G.xHƗ{l9r} M`IyFm`];A<9K,H235k;astk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/images/info.gif0000644004705000470430000000040012161053524022231 0ustar courtoisasterdevGIF89a 1!, I'E(X]`RBΣ 쁬&ǣ0+1[ sEե1w\LcD^ܪܶK}uFwdU+z9YFg]aN63[c%`W7V72/0!"õǻ˵;astk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/images/italic.gif0000644004705000470430000000015712161053524022554 0ustar courtoisasterdevGIF89a!,0I8m(d{y.);astk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/images/minus.xbm0000644004705000470430000000025112161053524022456 0ustar courtoisasterdev#define minus_width 9 #define minus_height 9 static char minus_bits[] = { 0xff,0x01,0x01,0x01,0x01,0x01,0x01,0x01,0x7d,0x01,0x01,0x01,0x01,0x01,0x01, 0x01,0xff,0x01}; astk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/images/new.gif0000644004705000470430000000020312161053524022070 0ustar courtoisasterdevGIF89a!,00I8c+fycifƲR{_M˻N/ȩl6#;astk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/images/opcopy.xbm0000644004705000470430000000030212161053524022631 0ustar courtoisasterdev#define opcopy_width 11 #define opcopy_height 11 static char opcopy_bits[] = { 0xff,0xff,0x01,0xfc,0x21,0xfc,0x21,0xfc,0x21,0xfc,0xfd,0xfd,0x21,0xfc,0x21, 0xfc,0x21,0xfc,0x01,0xfc,0xff,0xff}; astk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/images/open.gif0000644004705000470430000000021312161053524022241 0ustar courtoisasterdevGIF89a!,8PI ffE @ d˭R4|&PY ZZ/;astk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/images/openfold.gif0000644004705000470430000000022212161053524023106 0ustar courtoisasterdevGIF89a !, ?@y& @TDٝFmh7AoVn2[9Iu:z;astk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/images/oplink.xbm0000644004705000470430000000030212161053524022614 0ustar courtoisasterdev#define oplink_width 11 #define oplink_height 11 static char oplink_bits[] = { 0xff,0xff,0x01,0xfc,0xf1,0xfc,0xe1,0xfc,0xf1,0xfc,0xb9,0xfc,0x19,0xfc,0x09, 0xfc,0x11,0xfc,0x01,0xfc,0xff,0xff}; astk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/images/opmove.xbm0000644004705000470430000000030212161053524022625 0ustar courtoisasterdev#define opmove_width 11 #define opmove_height 11 static char opmove_bits[] = { 0xff,0xff,0x01,0xfc,0x01,0xfc,0x51,0xfc,0x89,0xfc,0xfd,0xfd,0x89,0xfc,0x51, 0xfc,0x01,0xfc,0x01,0xfc,0xff,0xff}; astk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/images/overstrike.gif0000644004705000470430000000016712161053524023505 0ustar courtoisasterdevGIF89a!,$0I8cn4Z'XJRͱֲ_;astk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/images/palette.gif0000644004705000470430000000022712161053524022743 0ustar courtoisasterdevGIF89a!,DpIX|Ǡ}Wj@xF*C<@ًv1xcI9K]2ލxL;astk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/images/passwd.gif0000644004705000470430000000074112161053524022607 0ustar courtoisasterdevGIF89a pppؘȠȘȘ000!,  b`dd BΩ`6 LU 0 ^S\.˄h(}`b.m1C@q/iAvP=h@ &UX` fIx;Xs 5Af|XI?A tufMA uyBtwH6WA%)&<£ƒ"I 8i$B"W V3+-8L,,Zd1\u}u2;astk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/images/paste.gif0000644004705000470430000000023712161053524022422 0ustar courtoisasterdevGIF89a!,LIXq) 'P^e+a6J.0 d28*@ΈDTP4vǕZiG;astk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/images/plus.xbm0000644004705000470430000000024612161053524022312 0ustar courtoisasterdev#define plus_width 9 #define plus_height 9 static char plus_bits[] = { 0xff,0x01,0x01,0x01,0x11,0x01,0x11,0x01,0x7d,0x01,0x11,0x01,0x11,0x01,0x01, 0x01,0xff,0x01}; astk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/images/print.gif0000644004705000470430000000021412161053524022435 0ustar courtoisasterdevGIF89a!,9PI8KDXgRXnBhZ]c@(~2 tО\;astk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/images/question.gif0000644004705000470430000000041112161053524023147 0ustar courtoisasterdevGIF89a 1!, I'E(X]`RBΣ t&>Pm|+`J g(bPKZVX`m H]_"z6vq:T}evj:lxRUz?4n_%A!6k&}X7I72/OŠŭžչ;astk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/images/redo.gif0000644004705000470430000000010612161053524022232 0ustar courtoisasterdevGIF89a!,oyM5i`(jAʶnR;astk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/images/save.gif0000644004705000470430000000021212161053524022235 0ustar courtoisasterdevGIF89a!,7PI8k}(bh%VKat Iu(婘4";astk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/images/target.xbm0000644004705000470430000000103312161053524022610 0ustar courtoisasterdev#define target_width 24 #define target_height 24 static unsigned char target_bits[] = { 0x00, 0x00, 0x00, 0x00, 0x07, 0x00, 0x00, 0x07, 0x00, 0x00, 0x07, 0x00, 0x00, 0x07, 0x00, 0x00, 0x07, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x3e, 0xe0, 0x03, 0x3e, 0xe0, 0x03, 0x3e, 0xe0, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x07, 0x00, 0x00, 0x07, 0x00, 0x00, 0x07, 0x00, 0x00, 0x07, 0x00, 0x00, 0x07, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; astk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/images/underline.gif0000644004705000470430000000016712161053524023275 0ustar courtoisasterdevGIF89a!,$0I8[AM#V~ۚ[jy;astk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/images/undo.gif0000644004705000470430000000016312161053524022251 0ustar courtoisasterdevGIF89a!, 0I8mQ |ɒ\\x_;astk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/images/warning.gif0000644004705000470430000000037612161053524022757 0ustar courtoisasterdevGIF89a !, Ig5-!@y*g(rEw@T aĖh\!`shl event added to tag BwDisabledEntry - fixed bug when -textvariable use a variable containing space * MainFrame - fixed bug when -textvariable use a variable containing space - menubar entry creation modified to use the menuid as the subpathname to permit special menu (help, system, apple) * LabelFrame - LabelFrame::align command added * ScrollableFrame - fixed typo bug * PagesManager - fixed bug of window size - 'pages' modified to optionally include first and last indices. ('page' is still available but deprecated) * NoteBook - new command 'bindtabs' - fixed bug in handling result of -leavecmd command - 'pages' modified to optionally include first and last indices. ('page' is still available but deprecated) * ComboBox - little border added around the popdown list, which appeared to have no border under windows when popped above a widget with the same background color. * SpinBox - options -repeatdelay and -repeatinterval added. * Tree - fixed strange behaviour when editing: 'selection range' replaced by 'selection from'/'selection to' - widget is redrawn if needed in 'edit' and 'see' - fixed bug in see - nodes modified to optionally include first and last indices. - _subdelete modified to iterative method * ListBox - fixed strange behaviour when editing: 'selection range' replaced by 'selection from'/'selection to' - ListBox is redrawn if needed in 'edit' and 'see' - fixed bug in see - 'items' modified to optionally include first and last indices. ('item' is still available but deprecated) * SelectColor - fixed bug in call to GlobalVar::trace renamed GlobalVar::tracevar * DragSite and DropSite - fixed bug introduced by new button event. * DynamicHelp - restored version of 1.1, due to the bug under windows * BWidget::place - fixed bug when x or y is 0. * es.rc resource file included ____________________________________________________________ BWidget 1.2 (05/21/1999) CHANGES FROM 1.1 TO 1.2 * 4 new widget: - ScrollableFrame - ScrollView - PagesManager - PasswdDlg (contributed by Stephane Lavirotte) * Widget: - Flag option type added - option resource database read while widget creation, not while widget class creation. - better handling of BWidget definition using another BWidget as a top pathname. * MainFrame - more options included for ProgressBar (INCOMPATIBILITY: option -variable renamed -progressvar) - -menu option modified to have tags on entries and menu id on cascad menu (INCOMPATIBILITY of option -menu) - new command: getmenu - new command: setmenustate * DropSite - operations completly reworked - option -droptypes modified (INCOMPATIBILITY) - return code of -dropovercmd modified bit 'ok' and bit 'recall' reverted (INCOMPATIBILITY in -dropovercmd command) - new command: setoperation * DragSite: - Drag now initiates while followed by of 4 pixels, so it is possible to have a event and drag event on the same button. - -dragevent option modified: must be the number of the button: 1, 2 or 3 Option is now defaulted to 1, but Entry widget keep it to 3. (INCOMPATIBILITY) - return result of -draginitcmd modified (INCOMPATIBILITY) * ListBox: - edit command improved. new arguments: initial text, and command to verify the text before accept it. (INCOMPATIBILITY in call to edit) - Drag and Drop modified (INCOMPATIBILITY in -dropovercmd command) - new command: reorder * Tree: - edit command improved. new arguments: initial text, and command to verify the text before accept it. (INCOMPATIBILITY in call to edit) - Drag and Drop modified (INCOMPATIBILITY in -dropovercmd command) - new command: reorder - new command: visible - less full-redraw * NoteBook: - relief reworked - added option -leavecmd on pages - option -image implemented - new command: move - delete command now accept an optionnal argument specifying whether the frame of the page should be destroyed or not. If not, this frame is reused by insert command for the same page. * Entry and LabelEntry: - direct access to entry command - bind command added on the entry subwidget * ComboBox: - option -postcommand added - bind command added on the entry subwidget * SpinBox: - bind command added on the entry subwidget - floating point fixed - work needed * ProgressBar: - now can be incremental or not limited ('unknow-time' processing) * Bitmap: - xpm image type added with use of xpm-to-image by Roger E. Critchlow Jr. * Lots of focus problem solved * ...and bugs corrected. INCOMPATIBILITIES Incompatibilities are very localized, so we hope that it will not be painfull to upgrade to 1.2. * MainFrame related imcompatibilities - Upgrade MainFrame -menu option and change -variable option by -progressvar. * Drag and drop related imcompatibilities - Upgrade -dragevent option, and command associated to -draginitcmd and -dropovercmd. - Upgrade -dragendcmd/-dragovercmd command of Tree and ListBox widget * Edition in Tree and ListBox - Verify arguments passed in call to edit command of Tree and ListBox ____________________________________________________________ BWidget 1.1 (03/12/1999) CHANGES FROM 1.0 TO 1.1 WHAT'S NEW The most important change in BWidget 1.1 is the support of tk path command, but the old syntax is always available. configure command now returns a valid configuration information list. (I hope that) All submitted bugs have been corrected. Following widget have been reworked: * ListBox: - ListBox items have now a -indent option. - insert command modified to look more as a tk listbox insert command (see INCOMPATIBILITIES) - item command added to retreive one or more items * Tree: - insert command modified to look more as a listbox insert command (see INCOMPATIBILITIES) * LabelEntry: - -value and -variable options renamed to -text and -textvariable (see INCOMPATIBILITIES) * SpinBox and ComboBox: - -value and -variable options renamed to -text and -textvariable (see INCOMPATIBILITIES) - New command getvalue and setvalue added to manipulate current value by index. * NoteBook: - Pages have now an identifier. - insert command modififed (see INCOMPATIBILITIES) - page command added to retreive one or more pages - getframe command added INCOMPATIBILITIES (sorry for this) * LabelEntry, SpinBox and ComboBox: - -value and -variable options renamed to -text and -textvariable * Entry and LabelEntry: - setfocus doesn't exist anymore. Directly use tk command focus. * NoteBook: - Pages have now an identifier, which modifies insert command: NoteBook::insert $nb index ?option value ...? is now $nb insert index page ?option value ...? * Tree: - insert command modified: Tree::insert $nb $parent $node $index ?option value ...? becomes $tree insert $index $parent $node ?option value ...? * ListBox: - insert command modified: ListBox::insert $list $item $index ?option value ...? becomes $list insert $index $item ?option value ...? ____________________________________________________________ BWidget 1.0 (02/19/1999) First release. astk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/ChangeLog0000644004705000470430000013332712161053524021133 0ustar courtoisasterdev2003-12-18 Bob Techentin **** BWIDGET 1.7.0 TAGGED **** * README.txt: Changed revision to 1.7.0. Note that 1.7.0 does not include 2003-11-26 mod to notebook.tcl. 2003-11-26 Jeff Hobbs * notebook.tcl (NoteBook::bindtabs): correct tab name returned. (groth) 2003-11-17 Jeff Hobbs * entry.tcl (Entry::create): add missing line continuation. [Patch #843932] (oehlmann) 2003-11-10 Damon Courtney * entry.tcl: Use a button widget for -disabled options if we're using 8.3 [Bug 839469] 2003-11-05 Damon Courtney * combobox.tcl: Fixed dropdown listbox selection for standard Tk listbox [Bug 831496]. 2003-11-05 Jeff Hobbs * scrollview.tcl (ScrollView::_set_view): correct :canvas to renamed :cmd. 2003-10-30 Jeff Hobbs * scrollw.tcl (ScrolledWindow::setwidget): check that the old widget associated still exists before unconfiguring it. [Bug #833034] 2003-10-27 Damon Courtney * combobox.tcl, listbox.tcl: Fixed keyboard navigation in the combobox drop down [Bug 831496]. * listbox.tcl: Added curselection subcommand to mimic Tk listbox behavior. Added keyboard navigation to the listbox. * widget.tcl: Added Widget::exists command to return whether a widget is a BWidget (based on whether it exists in the _class array). Widget::destroy now properly unsets the widget's variable in the _class array. 2003-10-27 Joe English * DragSite.html, DropSite.html: Fix markup errors [Bug #740484] 2003-10-20 Damon Courtney * arrow.tcl, bitmap.tcl, button.tcl, buttonbox.tcl, color.tcl, * combobox.tcl, dialog.tcl, dragsite.tcl, dropsite.tcl, entry.tcl * font.tcl, label.tcl, labelentry.tcl, labelframe.tcl, listbox.tcl * mainframe.tcl, messagedlg.tcl, notebook.tcl, pagesmgr.tcl * panedw.tcl, passwddlg.tcl, progressbar.tcl, progressdlg.tcl * scrollframe.tcl, scrollview.tcl, scrollw.tcl, separator.tcl * spinbox.tcl, titleframe.tcl, tree.tcl, utils.tcl, widget.tcl * xpm2image.tcl: Revamp again to let core Widget commands handle most of the esoteric work of creating and destroying widgets properly in the BWidget environment. The command Widget::define defines a class, its filename and a list of classes which it uses. This command handles creating the command to create new widgets, creates a ::use command for the class and calls the ::use command for each class included. The command Widget::create does the renaming of the widget to $path:cmd and creates the proc to redirect the widget commands. Widget::destroy now does the rename $path "" that almost all widgets do. * button.tcl: Added a -state option to configure the state of the entire box at once. Added new insert and delete subcommands. Added an after cancel to stop button repeat upon release. [Bug 697022] * combobox.tcl: Added -bwlistbox, -listboxwidth and -hottrack options. -images option already existed, but now it actually does something. Added getlistbox, get, icursor, post and unpost subcommands. * dynhelp.tcl: Added add subcommand to replace the (now) deprecated register command. The new command adds for a lot more flexibility in applying dynamic help. Help popup now comes up -topmost 1 on Windows if available. * entry.tcl: Added -disabledbackground option so that the BWidget entry more closely resembles the standard Tk entry. [Bug 638236]. * init.tcl: Moved Widget::traverseTo into widget.tcl. * label.tcl: Renamed BWLabel class to just Label. * listbox.tcl: Added a default -dropcmd so that if -dragenabled and -dropenabled are true, drag-and-drop within the same widget is possible without any other options. Added -autofocus option to specify that clicking within the listbox should draw the focus in order to handle mouse wheel events. Added -selectfill option for drawing a full selection rectangle around selected items instead of just around the item. Added getcanvas subcommand. [Bug 436762]. bindImage and bindText now map %W to $path in order to get an accurate path in events. This can probably be fixed better when we have more control over event parameters. [Bug 607745] Added mouse wheel bindings by default. Added <> event when selection changes. * mainframe.tcl: Fixed bug for adding CTRL-F items to a mainframe [Bug 784269] * messagedlg.tcl: Added -buttonwidth option. * notebook.tcl: Added dynamic help to tabs. Added -tabpady option to specify the padding between the text and the tab. Notebooks now handle multi-line text properly. [Bug 565284] * scrollview.tcl: Rewritten to use a variable per path instead of a big array. * tree.tcl: Added -anchor option to nodes to specify the anchor for an image or window when displayed. Added -crossopenimage, -crosscloseimage, -crossopenbitmap and -crossclosebitmap options to change the open / close cross. Added mouse wheel bindings by default. Added toggle subcommand to toggle a single tree node. Added <> event when selection changes. The characters "& | ^ !" are all converted to | silently in node names. This is to avoid errors because these characters are special to the canvas widget. [Bug 746960] bindImage and bindText now map %W to $path in order to get an accurate path in events. This can probably be fixed better when we have more control over event parameters. [Bug 607745] * utils.tcl: Added BWidget::wrongNumArgsString command to return a standard wrong # args error string. Added BWidget::classes command that returns a list of all classes required by a given class. Added BWidget::inuse command to determine if a given class is inuse. Added BWidget::library command to return a body of code that can be saved into a project or other code based on the given classes. When called with a list of classes, all the classes and code necessary to use those classes is returned in a large string which can then be written out to a file. Added BWidget::write command to write to a given file the current set of classes that are in use. Added BWidget::bindMouseWheel command to setup default mouse bindings on a given widget. * widget.tcl: Added a new option type 'Padding' which will accept the standard padding arguments in Tcl 8.4+. Added Widget::define command to define a new BWidget class. Added Widget::create command to create a BWidget properly. Widget::destroy now attempts to delete a widget command created through Widget::create. Added Widget::options command to return the current options of a given widget in a style that can be used to serialize a widget. Added Widget::getOption command to get options based on children having the same option. * wizard.tcl: Added new Wizard widget. 2003-10-17 Jeff Hobbs * arrow.tcl, bitmap.tcl, button.tcl, buttonbox.tcl, color.tcl, * combobox.tcl, dialog.tcl, dragsite.tcl, dropsite.tcl, entry.tcl * font.tcl, label.tcl, labelentry.tcl, labelframe.tcl, listbox.tcl * mainframe.tcl, messagedlg.tcl, notebook.tcl, pagesmgr.tcl * panedw.tcl, passwddlg.tcl, progressbar.tcl, progressdlg.tcl * scrollframe.tcl, scrollview.tcl, scrollw.tcl, separator.tcl * spinbox.tcl, titleframe.tcl, tree.tcl, utils.tcl, widget.tcl * xpm2image.tcl: major revamp to reduce incorrect use of eval and other list-safetiness evils. Also change !strcomp to streq. 2003-08-06 Jeff Hobbs * listbox.tcl: Correct Listbox selection drawing [Bug #781652] 2003-07-17 Joe English * init.tcl, combobox.tcl: Fix for [Bug 720032] "BWidget breaks Tk entry behaviour". Highlight the entry in a <> binding, instead of doing so on every event. Change the global and bindings to generate <> and <> events. 2003-07-17 Jeff Hobbs * notebook.tcl: Use list with eval for safety. Use lsearch -exact instead of default -glob in all uses. * listbox.tcl (_multiple_select): correct shift-selection when selectmode is multiple. [Bug 653266] Use lsearch -exact instead of default -glob in all uses. Use list with eval for safety. * BWman/ScrolledWindow.html: clarify management of embedded widget. 2003-06-23 Damon Courtney * combobox.tcl: Added a little better handling of keys in the auto-complete. 2003-06-06 Damon Courtney * combobox.tcl: Added a rudimentary auto-complete function with option (-autocomplete) that is turned off by default. Over time, I'm sure this function can be improved, but I think it works pretty well for now. * BWman/ComboBox.tcl: Added documentation for -autocomplete. 2003-06-05 Damon Courtney * listbox.tcl: Liberal use of list where appropriate to make the code safe for space-containing node names. 2003-05-23 Bob Techentin **** BWIDGET 1.6.0 TAGGED **** * README.txt: 2003-05-18 Jeff Hobbs * progressbar.tcl: correctly handle progressbar being quickly created and deleted by deleting afters and checking var existence. 2003-05-18 Joe English * widget.tcl (Widget::focusOK): Don't assume that '-editable' option is always 1 or 0 for all widgets. [Bug 710658] 2003-05-14 Jeff Hobbs * demo/tree.tcl: make the tree scrollview make sense in demo. [Bug 684462] * notebook.tcl: ensure that bd is min 1 at all times. [Bug 688227] Correct use of eval with list. * tree.tcl: correct node lsearch'ing to use -exact to allow for [] containing nodes [Bug 628041] (decoster) 2003-05-07 Jeff Hobbs * dynhelp.tcl (DynamicHelp::_motion_balloon): correctly listify after delayed _show_help callback. 2003-05-06 Jeff Hobbs * scrollw.tcl (ScrolledWindow::setwidget): remove any existing widget before setting the next. 2003-05-01 Jeff Hobbs * tree.tcl (Tree::configure, Tree::_draw_node): add a full-width box underneath the text and image/window that will react to the node binding if -selectfill is true. It is an empty box that is overly wide, but it could be improved to resize on Configure to just the window width and replace the sel box. 2003-04-23 Jeff Hobbs * tree.tcl: liberal use of list where appropriate to make the code safe for space-containing node names. Make use of string equal instead of !string compare. (Tree::_redraw_selection): correct -selectfill to include the image, in any, in the bbox calculation since it may be larger. 2003-04-15 Damon Courtney * listbox.tcl * tree.tcl: Added a #auto substitution for inserting new items into a tree or listbox. * BWman/ListBox.html * BWman/Tree.html: Added documentation for #auto substitution. 2003-04-14 Jeff Hobbs * utils.tcl (BWidget::focus): add optional refocus arg * combobox.tcl: make droplist use solid 1-pixel relief more in accordance with Windows style. Set topmost attribute on droplist. Add bindings that unmap the droplist if we lose focus to another application (where [focus] == ""), without refocusing to the entry. 2003-04-11 Jeff Hobbs * combobox.tcl (ComboBox::_expand): add tab expansion behavior when -expand tab is specified (ComboBox::_focus_in): autohighlight full contents only when no existing selection exists. [Bug #720024] * BWman/ComboBox.html: doc -expand none|tab 2003-03-12 Damon Courtney * listbox.tcl: Added dynamic help support to listbox items. * tree.tcl: Fixed a little inconsistency in the tree dynamic help. We don't need to save the whole path in the help array, just the node. 2003-02-25 Jeff Hobbs * scrollw.tcl: add lock around grid remove scrollbar to prevent infinite loop in small window situations. (kienzle) * pkgIndex.tcl: * configure.in: bumped to v1.6 * scrollw.tcl: complete rewrite of ScrolledWindow widget to address infinite loop scrollbar problems. This one is much simpler and does not suffer the infinite loop. There still seems to be an issue with shrinking smaller than one scrollbar width / height in size, but that's not common (nor fatal). Addresses [Patch #671821, #520903] [Bug #472718, #564691] This may introduce new incompatabilities, but it does work as expected for noted bugs and in the demos. * widget.tcl: code cleanup * scrollframe.tcl: code cleanup 2003-02-24 Jeff Hobbs * panedw.tcl (_realize): only allow _realize to be called once the Configure binding has triggered once. [Bug #613134] [Patch #63500] (decoster) 2003-02-17 Jeff Hobbs * font.tcl: comment out the adding of default style bits for bold and italic. The allows setting the font to something like "Courier 8", clicking B on and off and getting "Courier 8" back again (otherwise gave "Courier 8 normal roman"). 2003-02-08 Damon Courtney * BWman/SelectColor.html * color.tcl: Cleaned up some of the documentation of SelectColor and made it actually work like the documentation says it does. * BWman/DynamicHelp.html * dynhelp.tcl: Added -topbackground, -padx and -pady options to allow a little more flexibility in the look-and-feel of balloons. Added the ability to bind dynamic help to individual items or tags on a canvas. * BWman/Tree.html * tree.tcl: Added -padx and -deltax options to individual nodes within a tree. Each option defaults to -1, meaning to take its value from the global option of the same name. Added dynamic help to nodes within a tree. Adds the following options: -helptext, -helptype and -helpvar to each node. * BWman/BWidget.html * utils.tcl: Added BWidget::badOptionString utility to return a standard error string when a given option doesn't match a list. * BWman/Widget.html * widget.tcl: Added Widget::getVariable proc to create a reference to a variable relative to the given widget path. 2003-01-26 Damon Courtney * BWman/DynamicHelp.html: * dynhelp.tcl: Added -state option to disable help balloons on a global scale. * BWman/Tree.html: * tree.tcl: Added -crossfill option to allow the + / - bitmap to be filled with a different color than the connecting node lines. -linesfill is now accurate in its help entry and only adjusts the foreground color of the lines between the nodes. 2003-01-24 Joe English * tree.tcl (Tree::delete, Tree::_subdelete): remove all deleted nodes from the the selection [Bug #621178]. 2003-01-17 Pat Thoyts * labelentry.tcl: fixed -textvariable option [bug #649383] 2002-10-14 Jeff Hobbs * pkgIndex.tcl: * configure.in: bump version to 1.5 * button.tcl: remove -repeatdelay and -repeatinterval for 8.4 to allow Button to override them. [Bug #620103] * combobox.tcl: make -entrybg also control the listbox background. [Bug #519189] (chevreux) * tree.tcl (_see): change to always show left edge of requested item. [Patch #556077] (english) [NOTE: also included Patch #621331 "Allow delete of selected Tree nodes"] * dynhelp.tcl: allow variable and balloon help simultaneously. [Patch #567982] (decoster) * BWman/LabelFrame.html: * labelframe.tcl: allow -bitmap -image and -textvariable options of the BWLabel component of a LabelFrame. [Patch #620753] (decoster) * widget.tcl (_get_tkwidget_options): withdraw toplevel if it is the TkResource base widget. [Patch #620754] (decoster) * tree.tcl (delete): correct tree deletion with selected nodes. [Patch #621331] (decoster) * progressbar.tcl (_modify): use updated idletasks instead of update. [Patch #622927] (decoster) 2002-09-25 Jeff Hobbs * Makefile.in: better DESTDIR/libdir support (steffen) 2002-09-11 Jeff Hobbs * color.tcl (SelectColor::menu): added tkwait and update to make sure that the grab doesn't fail on Unix. * listbox.tcl: corrected multiple selectmode bindings. [Patch #483838, Bug #594853] (decoster) 2002-08-23 Andreas Kupries * tree.tcl: Modified subcommand 'includes' of the method 'selection to properly extract its argument. ... Revamped the whole subcommand to properly extract and check its arguments. (create) Added Control-Button-1 bindings to allow toggling the selection of a node. I will do no bindings for shift-selecting and/or drag-selecting ranges. To complex for me right now. Moved the code executing the -selectcommand callback to an internal procedure, and added calls to that procedure to all subcommands which change the selection. This fixes SF Bwidget Bug #547245. * BWman/Tree.html: Documented the 'includes' and 'range' subcommands of the method 'selection' of tree widgets. Documented the node option '-selectable'. Documented that the subcommands extending or setting the selection silently ignore unselectable nodes. Documented new 'toggle' subcommand of method 'selection'. Documented option --slectcommand'. Fixed bogus table html in option lists. 2002-06-04 Jeff Hobbs **** BWIDGET 1.4.1 TAGGED **** * README.txt: * configure.in: * pkgIndex.tcl: up'ed version to 1.4.1 * listbox.tcl: corrected use of 'end' as move index. [Bug #561391] * buttonbox.tcl: * tree.tcl: force frame -padx/-pady to 0 to handle 8.4+ frame padding options. [Bug #545119] * scrollframe.tcl: corrected scrollregion configuration on Configure of frame to use full width/height of canvas when the canvas is larger. This ensures that scrolling "anchors" properly to topleft. * dialog.tcl: prevent dialog from freezing on Windows with tkwait visibility on withdrawn toplevels. [Patch #521386] (chevreux) * font.tcl: reworked loadfont to not sort font names unless requested. [Patch #524353] (kienzle, hobbs) * panedw.tcl: corrected handling of weighted panes following a Configure event. [Patch #513320] (decoster) * progressbar.tcl: Fixed display of vertical progressbar. [Patch #561403] 2002-05-29 Andreas Kupries * combobox.tcl: Changed relief of popup list to ridge, for Win* platforms. 2002-05-09 Andreas Kupries * dynhelp.tcl: Accepted patch for bug 528929. Reported by , patch also by him. 2002-04-25 Andreas Kupries * notebook.tcl: Accepted patch for bug #532246, fixing the appearance of the tabs so that text is always visible completely. 2002-01-26 Pat Thoyts * utils.tcl: Modified BWidget::place to support multiple screens under Windows. Better support would require Tk modifications. * demo/tree.tcl: Fixed for starting on secondary monitor under windows. * BWMan/BWidget.html: added documentation for BWidget::place. 2002-01-22 Jeff Hobbs **** BWidget 1.4.0 tagged **** * widget.tcl: added Color as an optional type, with _test_color test. [RFE #443124]. 2002-01-15 Jeff Hobbs * BWman/ComboBox.html: removed reference to label options that were removed when the LabelFrame was dropped. [Bug #477130] * listbox.tcl: allowed drop handler to work in empty listbox. [Bug #456883] * mainframe.tcl: correct unprotected eval calls. [Patch #501210] (chevreux) 2001-12-28 Jeff Hobbs * BWman/Dialog.html: * dialog.tcl: Added '-transient' and '-place' flags. [Patch #483838] (decoster) * BWman/Tree.html: * tree.tcl: Added a 'recursive' argument to 'Tree::opentree' and 'Tree::closetree'. [Patch #483838] (decoster) * BWman/ProgressBar.html: * progressbar.tcl: Added new type 'nonincremental_infinite' and modified movement of progressbar when in 'infinite' or 'nonincremental_infinite' mode. The 'nonincremental_infinite' can be used when a certain process monitored by a ProgressBar returns a total count and not an increment count. [Patch #483838] (decoster) * BWman/PanedWindow.html: * panedw.tcl: Added '-weights' flag with possible value 'extra' or 'available'. Since BWidget-1.3.1, the meaning of the '-weight' flag for the 'PanedWindow::add' command was changed. This made it difficult to create a layout where the panes occupy a certain amount of the screen. When using the '-weights extra' flag when creating a PanedWindow widget, the >=1.3.1 behavior is used: the weights for the different panes are only used for extra space. When using the '-weights available' flag, the weights for the different panes are used to set the size of each panes relative to the total available space. [Patch #483838] (decoster) * BWman/ListBox.html: * listbox.tcl: Added '-selectmode' flag and 2 possible select-modes: single and multiple. [Patch #483838] (decoster) * widget.tcl: Select element 4 (was 3) from the config-options to get value from optiondb. [Patch #483838] (decoster) * utils.tcl: added else case to place is called with location different from 'at' and 'center' and without a parent. [Patch #484123] (decoster) * mainframe.tcl: added options -menubarfont, -menuentryfont and -statusbarfont at creation time of the widget as well as subsequent configures. [Patch #479935] (chevreux) * listbox.tcl: added multipleinsert command to allow faster inserts of multiple items. [Patch #458446] (chevreux) * widget.tcl: added Widget::copyinit. [Patch #458446] (chevreux) * BWman/NoteBook.html: * notebook.tcl: added options for enhanced tab shape in notebooks. [Patch #402466] (haneef) * configure.in: * pkgIndex.tcl: * README.txt: bumped version to 1.4.0 (not released) * mainframe.tcl (_create_menubar): start tagstate initially on. [Patch #470273] (chevreux) (_parse_accelerator): improve F* function key accelerator support. [Patch #444172] (venski) 2001-10-14 Jeff Hobbs * pagesmgr.tcl: reverted fix of 2001-10-11 - it was bogus. 2001-10-11 Jeff Hobbs * pagesmgr.tcl: allowed the ability to specify page by name, not just number. 2001-09-11 Andreas Kupries * notebook.tcl: Removed 'Canvas' from the list of bindtags for the internal canvas to prevent interference from application specific bindings with our special widget. [459033]. 2001-09-06 Andreas Kupries * passwddlg.tcl: Accepted change by Bastien Chevreux adding a -logineditable option to the password dialog. [436340]. 2001-09-05 Andreas Kupries * panedw.tcl: Added option -activator to allow user to choose sash activator. Reduced minimum allowed sash width. [442474]. Request made by Bastien Chevreux . * label.tcl: Corrected typo in BWlabel::configure [454505], report and fix by Bastien Chevreux . * arrow.tcl: Changed containing frame to be more invisible (borderwidth 0). Fixes [458301], by Georgios Petasis . 2001-08-08 Andreas Kupries * tree.tcl (Tree::_keynav): Added code to call the open and close commands when the open-status of a node is toggled with the space bar. Bug [449284]. * color.tcl: Added the missing definition of the main 'SelectColor' procedure. This prevented users from creating these widgets in the documented way. Bug [449276]. 2001-06-21 eric melski * tree.tcl: Corrected keyboard navigation so that open/close commands are invoked when right/left arrows are used to open/close nodes, patch from [Bug #435097]. Also corrected keyboard navigation on right arrow press; previously only opened closed nodes that had children, but should always open nodes, regardless of whether it has children. 2001-06-11 Jeff Hobbs * pkgIndex.tcl: bumped version to 1.3.1 and added Tk 8.1.1 package require as Tcl 8.1.1 is needed in certain core areas for the new string methods. * mainframe.tcl: corrected state interpretation. It doesn't do exact argument matching, but it is consistent with the rest of BWidget. [Bug #224476] * demo/demo.tcl: fixed demo script to run when called from another directory * messagedlg.tcl: corrected winfo exists call * listbox.tcl: fixed string compare call * combobox.tcl: added package require Tk 8.3. * passwddlg.tcl: * xpm2image.tcl: * mainframe.tcl: * panedw.tcl: * utils.tcl: * entry.tcl: * dynhelp.tcl: * dragsite.tcl: * color.tcl: added braces to expr where appropriate 2000-10-31 Dan Kuchler * combobox.tcl: Added the '-exact' option to the 'lsearch' commands in the combobox code so that the correct index of items will be returned even when there are glob/regexp characters. 2000-10-10 Dan Kuchler * dynhelp.tcl: Added the '-screen' option to the toplevel that is created to display the help text to fix a bug reported by Tupone Alfredo. 2000-10-01 Eric Melski * notebook.tcl: Fixed typo in _draw_page that incorrectly placed images on tabs. 2000-09-17 Eric Melski * widget.tcl (_test_boolean): Altered to return strictly 0 or 1 (for false and true, respectively), rather than allowing the string booleans (false, true, off, on, etc). 2000-09-07 Sven Delmas * mainframe.tcl: Fixed the typo of Alt (Atl) as reported in bug # 6079. 2000-09-05 Eric Melski * label.tcl: Corrected bindtags for BWidgets Label components: primary component widget now includes the megawidget pathname in its bindtags list, so that bindings on the megawidget pathname are applied properly. 2000-08-10 Eric Melski * widget.tcl: Corrected a problem caused by the destruction of the special .#BWidget* widgets, which are used by BWidgets for some option value validations; formerly, if these were destroyed, it could confuse the BWidgets system's internal state, and creating BWidgets after destroying these helper widgets would throw an error. 2000-06-14 Dan Kuchler * dialog.tcl * dropsite.tcl * dynhelp.tcl * scrollview.tcl: Replaced several catch {unset varname} calls with if {[info exists varname]} {unset varname}. This avoids using the catch, and also prevents the ::errorInfo corruption that was happening in BWidgets. 2000-05-14 Dan Kuchler * tree.tcl: Fixed a typing error in the Tree::find procedure. The procedure wouldn't work because there was a 'llengh' where there should have been a 'llength'. 2000-05-08 Dan Kuchler * titleframe.tcl: Added a '-state' flag that is associated to the state of the label. Now that labels can be disabled (in 8.3 and beyond) this allows for the titleframe to have a disabled appearence. 2000-05-02 Eric Melski * tree.tcl: Did some fancy focus footwork [Bug: 4491]. Now you can do this: "Tree .t ; bind .t foo", and it will do the right thing. This will enable the use of proper focus-on-mouse-click bindings for trees, which in turn will fix the focus problem described in 4491. In addition, I added a binding to the canvas widget in the tree that redirects focus when it leaves the canvas and goes to the frame, just in case. * dialog.tcl: Added a -geometry option, to allow the specification of geometry for the dialog. No particular care is taken to validate the geometry string, so if it is bogus, you lose. [RFE: 5188]. 2000-04-27 Eric Melski * entry.tcl: Added smarts to handle Copy for non-editable entries (it should be allowed, but was not previously) [Bug: 3755]. * notebook.tcl: Small tweaks for placement of images on tabs. * combobox.tcl: Added code to ensure that non-editable (but enabled) comboboxes could still be tabbed in to. 2000-04-26 Dan Kuchler * button.tcl: Fixed the bindings that get setup on buttons with an underline specified to be case insensitive (i.e if 'A' or 'a' was the underline character, Alt-A and Alt-a would both be bound to the button. 2000-03-29 Sven Delmas * tree.tcl: Added protection for the left arrow key click in case we are already at the root node. This used to throw a Tcl error (fixes bug # 4619). 2000-03-20 Eric Melski * progressbar.tcl: (configure) Added test for change to -maximum value, so that bar is redrawn if maximum changes. [Bug: 4399]. * BWman/SpinBox.html: Removed references to -label* options. * demo/select.tcl: Removed use of -label* options on ComboBox and SpinBox. [Bug: 4394]. 2000-03-14 Eric Melski * button.tcl: (configure) replaced several hasChanged calls with one hasChangedX call. * dynhelp.tcl: (sethelp) replaced several hasChanged calls with one hasChangedX call. * entry.tcl: Replaced stack of hasChanged calls with one hasChangedX (in configure); replaced a couple cget's with getMegawidgetOption's. * spinbox.tcl: Updated _test_options to use setMegawidgetOption, and to only do that if it has to, instead of always doing it. * tree.tcl: Worked on itemcget; instead of upvar'ing the one-time-use variable, just refer to it directly. * widget.tcl: One problem with [set ${class}::${path}:opt($option)] -- if path contains "foo(foo)", the command will choke. Removed that particular micro-optimization. Added setMegawidgetOption to compliment getMegawidgetOption; extended hasChangedX to accept multiple options to check. This allows us to compress stacks of hasChanged calls into a single call (so there's a single function call, and a single upvar...). 2000-03-13 Eric Melski * combobox.tcl: Tweaked bg/background options so that button didn't pick up entry background. * widget.tcl: Removed dead code; micro-optimizations to initFromODB. * tree.tcl: Added option for default -fill of tree nodes on windows. * notebook.tcl: Removed commented code. * button.tcl: * tree.tcl: * spinbox.tcl: * entry.tcl: * dropsite.tcl: * dragsite.tcl: * arrow.tcl: Replaced selected cget/getoption calls with getMegawidgetOption calls. * combobox.tcl: Removed LabelFrame from ComboBox (30% faster). * widget.tcl: Added getMegawidgetOption function, which allows direct access to megawidget-specific options (those that do not map to a component widget option). This is dangerous, because it bypasses some checks, and it will only work with options that are specific to the megawidget. However, it is much faster, and enables some functions (like visiblenodes) to be much faster. * tree.tcl: Reworked visiblenodes function to do a tree walk to find visible nodes. This is faster and more correct than the previous implementation, which queried all the nodes in the tree for their open bit. 2000-03-10 Eric Melski * widget.tcl: Replaced an upvar with a direct reference to the variable in initFromODB. * dynhelp.tcl: Changed sethelp function to use new hasChangedX function instead of hasChanged, which avoids an unneeded upvar, for a little better speed. * button.tcl: Changed to parseArgs/initFromODB format for a small (25%) speedup in creation time. 2000-03-10 Sven Delmas * tree.tcl: Changed the allnodes procedure to visiblenodes, and also the mechanism of retrieving those nodes. This took care of the previously required update. 2000-03-09 Eric Melski * entry.tcl: Added code to re-sync the -text option with the contents of the entry widget before doing configuration; this fixes [Bug: 4304]. 2000-03-09 Sven Delmas * tree.tcl: Disabled the update before the find withtag in the allnodes procedure. The nodes are apparently created delayed, so before this procedure is called, the program has to do an update. I don't do this in the procedure anymore, because it caused multiple updates, making the app slower. 2000-03-08 Sven Delmas * tree.tcl: The new allnodes procedure was not handling the "current" tag correctly. This is now stripped of. 2000-03-07 Eric Melski * button.tcl: Added check for -state flag, to initialize it properly. * entry.tcl: Changed to parseArgs/initFromODB format; added check for -text flag to initialize it properly. * labelentry.tcl: Changed to use parseArgs/initFromODB format. 2000-03-03 Eric Melski * spinbox.tcl: Added a call in setvalue to scan the current value into a float to trim out any 0 padding on the number (otherwise the zero's make it look like octal to tcl, which chokes on numbers > 8) 2000-03-07 Sven Delmas * passwddlg.tcl: Reenabled the binding to activate the ok button. * dragsite.tcl: I added an extra protection into the _begin_drag procedure to guard against a motion event that (sometimes) arrives before the press event. This fixes bug # 4324. 2000-03-03 Eric Melski * spinbox.tcl: Removed LabelFrame from SpinBox (BACKWARDS INCOMPATIBLE) to speed creation; updated configure proc to use hasChangedX instead of hasChanged, as it didn't really need the values of the options it was checking. 2000-03-01 Eric Melski * spinbox.tcl: Changed bindings to be on class SpinBox instead of BwSpinBox, and added class SpinBoxEntry to the bindtags of the SpinBox entry component. * configure.in: * pkgIndex.tcl: Bumped version to 1.3.0. * tree.tcl: Changed focus redirect to use {after idle} to avoid focus loops. * label.tcl: Added -bd 0 -highlight... etc to wrapper frame; moved class bindings to the frame instead of the component label. * utils.tcl: Added helper function BWidget::refocus, to handle focus redirection calls. * spinbox.tcl: Changed focus redirect to use {after idle} to avoid focus loops. * combobox.tcl: Changed init to parseArgs/initFromODB style; changed focus redirect to use {after idle} to avoid focus loops. 2000-02-29 Eric Melski * widget.tcl: Added bits to handle $path#subclass_that_inherits_from_other_bw_class megawidget names. * passwddlg.tcl: * progressdlg.tcl: * progressbar.tcl: Changed init to parseArgs/initFromODB style. * pkgIndex.tcl: Changed Label -> BWLabel * messagedlg.tcl: Changed initialization to parseArgs/initFromODB style. Changed to use tk_messageBox on UNIX. * labelframe.tcl: Updated to use BWLabel instead of Label. * labelentry.tcl: Added -class LabelEntry to widget. * label.tcl: Changed class name to BWLabel (to avoid option db clashes with tk labels), changed initialization to parseArgs/initFromODB style. * init.tcl: dropped obsolete Tree option from init. * dialog.tcl: changed initialization to parseArgs/initFromODB style. * notebook.tcl: Added -bd 0 -highlightthickness 0 -relief flat to the notebook container frame so geometries are correct. * entry.tcl: Fixed a conflict with configuring the Entry -text and textvariables. * dialog.tcl: added a -class option to the dialog, to allow the class of the dialog to be set (this enables proper optiondb use for things like the PasswdDlg). 2000-02-28 Eric Melski * widget.tcl: Added Widget::varForOption function, which returns a variable name that can be used to trace changes to an option for a particular megawidget (such as the -values option of a combobox). * entry.tcl: Made cget -text a little more efficient by shortcircuiting in that case. * combobox.tcl: Fixed bug #4248 by making the listbox use a -listvariable instead of trying to micromanage the listbox contents. * tests/entry.test: tests for the Entry widget. * widget.tcl: minor code cleanup. * tree.tcl: Was not getting proper default bg color on Windows, and keyboard navigation was goofy because of internal structure changes. * entry.tcl: Fixed an issue with initial foreground color not being picked up correctly. 2000-02-28 Sven Delmas * tree.tcl: Added a procedure called "allnodes" to retrieve the names of all currently defined treenodes. Apparently the internal widget structure of tree was changed recently. I adjusted the "allnodes" procedure to that. 2000-02-25 Eric Melski * combobox.tcl: Fixed a problem with non-editable comboboxes and selecting values. * arrow.tcl: Fixed a problem with the invoke method (doing one too many winfo parents in some cases) * button.tcl: * buttonbox.tcl: * combobox.tcl: * dialog.tcl: * dynhelp.tcl: * entry.tcl: (also fixed validation) * label.tcl: * labelframe.tcl: * listbox.tcl: * mainframe.tcl: * notebook.tcl: * pagesmgr.tcl: * panedw.tcl: * progressbar.tcl: * scrollview.tcl: * scrollw.tcl: * separator.tcl: * spinbox.tcl: * titleframe.tcl: * tree.tcl: Updated to new megawidget architecture. * widget.tcl: Changed internal architecture. When possible, megawidget options are stored in component widgets instead of in an intermediary array. Also, made use of option database to make megawidget creation more efficient. 2000-02-24 Eric Melski * LICENSE.txt: Removed LGPL license; added Tcl-license terms. 2000-02-23 Eric Melski * widget.tcl: Replaced _test_boolean function with a more efficient implementation. 2000-02-18 Eric Melski * images/target.xbm: Placeholder for actual icon. * color.tcl: Change env(BWIDGET_LIBRARY) to ::BWIDGET::LIBRARY; changed proc "dialogue" to "dialog" * pkgIndex.tcl: Updated function spec for color.tcl. * widget.tcl: Various minor speed tweaks; added a reverse mapping from component widget options -> mega-widget options so that subcget can be faster. * entry.tcl: * dropsite.tcl: * dragsite.tcl: * arrow.tcl: Tcl list'd the specs for Widget::declare calls. * combobox.tcl: Removed extraneous ListBox::use call. 2000-02-17 Eric Melski * notebook.tcl: Added an extra check to move the leftmost tab a touch to the right when it is not selected (again, to make the tabs more Windows-like). Also replaced redundant [string equal] checks with a stored pre-check (ie, set foo [string equal ...]). 2000-02-16 Eric Melski * notebook.tcl: Changed appearance of tabs; leftmost tab is now flush with the left of the notebook, and the tabs look more Windows-like. 2000-02-16 Sven Delmas * dialog.tcl: Added a new parameter to the draw procedure that allows me to pass in the desired geometry for the window. This was needed to support tracking of dialog window geometries. * tree.tcl: Changed the binding to use "+", so it will not overwrite existing bindings (if there are any). Also added some extra protection in the keynav procedure against the user typing on a root node (this used to cause a stack trace). 2000-02-11 Eric Melski * tree.tcl: Integrated changes from Eric Boudaillier: [itemconfigure -open ...] optimized to only call redraw_idle 3 if node has subnodes. _cross_event: itemconfigure -open called before -opencmd/closecmd; no more call to _redraw_idle (handled by other procedures) _over_cmd: allow position {root 0} when tree is empty new [find] command: [find @x,y ?confine?] if confine is "confine" returns the node at window coordinate x,y (x,y must be inside the bbox of the node) else returns the node found on the line (in pixel) pixel y [find line] returns the node on the line $line (in -deltay coords) new [line] command: [line node] returns the line where node is drawn -selectfill option added: if true, selection is draw on full width of tree (instead of just highlighting the bbox of the selected nodes) * combobox.tcl: Integrated changes from Eric Boudaillier: internal widget restructuring. * tree.tcl: Added "range" subcommand to selection. Given two nodes, node1 and node2, it will set the selection to the visible nodes between (and including) node1 and node2. If node1 or node2 is not visible, it will find the first visible ancestor of the node and use that as the start/end point instead. * listbox.tcl: Integrated changes from Eric Boudaillier: _over_cmd: allow position 0 when listbox is empty find command, similar to tree find command. * spinbox.tcl: Integrated changes from Eric Boudaillier: cosmetic changes. * color.tcl: Integrated changes from Eric Boudaillier: split widget into two commands: SelectColor::menu and SelectColor::dialog. * progressbar.tcl: Integrated changes from Eric Boudaillier: added -idle option to prevent call to update in case where task is done in idle (ie, fileevents) * scrollview.tcl: Integrated changes from Eric Boudaillier: bindings changed. * scrollw.tcl: Integrated changes from Eric Boudaillier: -managed option: if true, scrollbar are managed during creation, so their size are included in the requested size of the ScrolledWindow. If false, they are not. -sides option: specifies the side of the scrollbar. -size option: specifies size of scrollbar. -ipad option: specifies pad between scrollbar and scrolled widget. * mainframe.tcl: Integrated changes from Eric Boudaillier: support for function keys in accelerators, support for no modifier in accelerators. * notebook.tcl: Integrated changes from Eric Boudaillier: -internalborderwidth (-ibd) option specifies pad around pages; -foreground, -background, -activeforeground, -activebackground, -disabledforeground options for each tab. Code cleanup. 1999-12-23 Sven Delmas * scrollw.tcl: Added "update idletask" to scrollbar update to prevent loss of update events. 1999-12-14 Sven Delmas * combobox.tcl: When the selected item is changed, the selection is now set to the entire string. 1999-12-13 Eric Melski * buttonbox.tcl: Added a getbuttonstate function, which retrieves the value of a tag used on a button in the buttonbox. 1999-12-08 Eric Melski * combobox.tcl: Removed code that cleared entry selection on focus out events, as this crippled exportselection. 1999-10-29 Eric Melski * buttonbox.tcl: Added a gettags function, which allows the user to query the tags that are used on buttons in the buttonbox. 1999-10-29 Eric Melski * font.tcl: Added one new flag: -querysystem. This lets the user control whether the font selector queries the system (via font families) for the list of fonts, or if it uses a preset list of fonts (which is much faster and less likely to crash some systems). 1999-10-25 Eric Melski * font.tcl: Added support for two new flags: -families and -styles; -families allows you to specify one of all, fixed, or variable, to limit the choice of fonts to those fonts; -styles allows you to specify a list of styles that can be set with the widget (ie, bold, italic, etc). 1999-10-22 Eric Melski * tree.tcl: Fixed some problems with keyboard traversal. Added support for left/right arrows a la MS Explorer. Added support for keyboard-based scrolling. 1999-10-21 Sven Delmas * combobox.tcl: Added support for keyboard traversal. The widget will now tab in even when it is not editable. Also the entry widget content will be selected when the user tabs in. The key bindings now allow a traversal of the list ( brings up the list). The arrow button no longer switches to an up button, but instead changes relief. The button is now more Windows NT like (for Windows NT). Changed keyboard bindings: down/up now display/hide the listbox; control-{up|down|prev|next} move through the options without displaying the listbox. 1999-10-21 Eric Melski * tree.tcl: Added a -selectable option to tree nodes, which controls whether or not a given node is selectable (duh). This works with the new -selectcommand option for the tree, and with keyboard traversal (also new). Now, whenever the tree gets a "selection set", it calls the given -selectcommand with the name of the tree and the list of selected nodes, which makes it easier to just drop in place and use. 1999-10-15 Eric Melski * panedw.tcl: Added a -class PanedWindow option to the main frame (the megawidget) of the paned window. 1999-10-15 Eric Melski * dialog.tcl: Added an overrideredirect option to Dialog::draw, which allows the user to control the overrideredirect state of the dialog. 1999-09-19 Eric Melski * mainframe.tcl: Fixed _destroy to unset ALL state variables, so that when a new MainFrame of the same name as an old one is created, it doesn't pick up residual state from the old one. 1999-09-17 Eric Melski * notebook.tcl: Added some (non-functional) code for doing tab-notebooks with the tabs on the bottom. astk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/LICENSE.txt0000644004705000470430000000420612161053524021175 0ustar courtoisasterdevBWidget ToolKit Copyright (c) 1998-1999 UNIFIX. Copyright (c) 2001-2002 ActiveState Corp. The following terms apply to all files associated with the software unless explicitly disclaimed in individual files. The authors hereby grant permission to use, copy, modify, distribute, and license this software and its documentation for any purpose, provided that existing copyright notices are retained in all copies and that this notice is included verbatim in any distributions. No written agreement, license, or royalty fee is required for any of the authorized uses. Modifications to this software may be copyrighted by their authors and need not follow the licensing terms described here, provided that the new terms are clearly indicated on the first page of each file where they apply. IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. GOVERNMENT USE: If you are acquiring this software on behalf of the U.S. government, the Government shall have only "Restricted Rights" in the software and related documentation as defined in the Federal Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you are acquiring the software on behalf of the Department of Defense, the software shall be classified as "Commercial Computer Software" and the Government shall have only "Restricted Rights" as defined in Clause 252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the authors grant the U.S. Government and others acting in its behalf permission to use and distribute the software in accordance with the terms specified in this license. astk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/README.txt0000644004705000470430000001073112161053524021050 0ustar courtoisasterdevBWidget ToolKit 1.7.0 December 2003 Copyright (c) 1998-1999 UNIFIX. Copyright (c) 2001-2002 ActiveState Corp. See the file LICENSE.txt for license info (uses Tcl's BSD-style license). -------------------------------------------------------------------------- WHAT IS BWIDGET ? The BWidget Toolkit is a high-level Widget Set for Tcl/Tk built using native Tcl/Tk 8.x namespaces. The BWidgets have a professional look&feel as in other well known Toolkits (Tix or Incr Widgets), but the concept is radically different because everything is pure Tcl/Tk. No platform dependencies, and no compiling required. The code is 100% Pure Tcl/Tk. The BWidget library was originally developed by UNIFIX Online, and released under both the GNU Public License and the Tcl license. BWidget is now maintained as a community project, hosted by Sourceforge. Scores of fixes and enhancements have been added by community developers. See the ChangeLog file for details. -------------------------------------------------------------------------- WIDGET LIST (1.7) Simple Widgets Label Extended Label widget Entry Extended Entry widget Button Extended Button widget ArrowButton Button widget with an arrow shape. ProgressBar Progress indicator widget ScrollView Display the visible area of a scrolled window Separator 3D separator widget Manager Widgets MainFrame Manage toplevel with menu, toolbar and statusbar LabelFrame Frame with a Label TitleFrame Frame with a title ScrolledWindow Generic scrolled widget ScrollableFrame Scrollable frame containing widget PanedWindow Tiled layout manager widget ButtonBox Set of buttons with horizontal or vertical layout PagesManager Pages manager widget NoteBook Notebook manager widget Dialog Dialog abstraction with custom buttons Composite Widgets LabelEntry LabelFrame containing an Entry widget. ComboBox ComboBox widget SpinBox SpinBox widget Tree Tree widget ListBox ListBox widget MessageDlg Message dialog box ProgressDlg Progress indicator dialog box PasswdDlg Login/Password dialog box (contributed by Stephane Lavirotte) SelectFont Font selection widget SelectColor Color selection widget Commands Classes Widget The Widget base class DynamicHelp Provide help to Tk widget or BWidget DragSite Commands set for Drag facilities DropSite Commands set for Drop facilities BWidget Utilities -------------------------------------------------------------------------- INSTALLATION AND USE - On Unix Platform: Uncompress the file BWidget-.tar.Z|gz To use the BWidget: - If you have uncompressed the archive file under the Tcl Library Path directory, you only need to do: % package require BWidget - If not, you have to specify the BWidget installation path in auto_path global variable: % lappend auto_path % package require BWidget To launch the demo, you need to cd into the demo subdirectory: $ cd /demo $ wish demo.tcl - On Windows and others Platforms: Uncompress the file BWidget-.zip To use the BWidget: - If you uncompressed the archive file under the Tcl Library Path directory, you only need to do: % package require BWidget - If not, you have to specify the BWidget installation path in auto_path global variable: % lappend auto_path your_path % package require BWidget To launch the demo : Double click on demo.tcl in the demo subdirectory Distribution contains these directories: BWidget- Root directory and BWidget Tcl sources BWman HTML manual pages images images used by BWidget lang Resources for language customization demo Demo sources tests BWidgets test suite -------------------------------------------------------------------------- DOCUMENTATION HTML manual pages are available in the BWman subdirectory. Point to index.html for frame version with tree navigation, or to contents.html for no frame version. -------------------------------------------------------------------------- CONTACTS The BWidget toolkit is maintained on Sourceforge, at http://www.sourceforge.net/projects/tcllib/ astk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/aclocal.m40000644004705000470430000000003712161053524021210 0ustar courtoisasterdevbuiltin(include,config/tcl.m4) astk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/arrow.tcl0000644004705000470430000005155512161053524021221 0ustar courtoisasterdev# ------------------------------------------------------------------------------ # arrow.tcl # This file is part of Unifix BWidget Toolkit # ------------------------------------------------------------------------------ # Index of commands: # Public commands # - ArrowButton::create # - ArrowButton::configure # - ArrowButton::cget # - ArrowButton::invoke # Private commands (redraw commands) # - ArrowButton::_redraw # - ArrowButton::_redraw_state # - ArrowButton::_redraw_relief # - ArrowButton::_redraw_whole # Private commands (event bindings) # - ArrowButton::_destroy # - ArrowButton::_enter # - ArrowButton::_leave # - ArrowButton::_press # - ArrowButton::_release # - ArrowButton::_repeat # ------------------------------------------------------------------------------ namespace eval ArrowButton { Widget::define ArrowButton arrow DynamicHelp Widget::tkinclude ArrowButton button .c \ include [list \ -borderwidth -bd \ -relief -highlightbackground \ -highlightcolor -highlightthickness -takefocus] Widget::declare ArrowButton [list \ [list -type Enum button 0 [list arrow button]] \ [list -dir Enum top 0 [list top bottom left right]] \ [list -width Int 15 0 "%d >= 0"] \ [list -height Int 15 0 "%d >= 0"] \ [list -ipadx Int 0 0 "%d >= 0"] \ [list -ipady Int 0 0 "%d >= 0"] \ [list -clean Int 2 0 "%d >= 0 && %d <= 2"] \ [list -activeforeground TkResource "" 0 button] \ [list -activebackground TkResource "" 0 button] \ [list -disabledforeground TkResource "" 0 button] \ [list -foreground TkResource "" 0 button] \ [list -background TkResource "" 0 button] \ [list -state TkResource "" 0 button] \ [list -troughcolor TkResource "" 0 scrollbar] \ [list -arrowbd Int 1 0 "%d >= 0 && %d <= 2"] \ [list -arrowrelief Enum raised 0 [list raised sunken]] \ [list -command String "" 0] \ [list -armcommand String "" 0] \ [list -disarmcommand String "" 0] \ [list -repeatdelay Int 0 0 "%d >= 0"] \ [list -repeatinterval Int 0 0 "%d >= 0"] \ [list -fg Synonym -foreground] \ [list -bg Synonym -background] \ ] DynamicHelp::include ArrowButton balloon bind BwArrowButtonC {ArrowButton::_enter %W} bind BwArrowButtonC {ArrowButton::_leave %W} bind BwArrowButtonC {ArrowButton::_press %W} bind BwArrowButtonC {ArrowButton::_release %W} bind BwArrowButtonC {ArrowButton::invoke %W; break} bind BwArrowButtonC {ArrowButton::invoke %W; break} bind BwArrowButton {ArrowButton::_redraw_whole %W %w %h} bind BwArrowButton {ArrowButton::_destroy %W} variable _grab variable _moved array set _grab {current "" pressed "" oldstate "" oldrelief ""} } # ----------------------------------------------------------------------------- # Command ArrowButton::create # ----------------------------------------------------------------------------- proc ArrowButton::create { path args } { # Initialize configuration mappings and parse arguments array set submaps [list ArrowButton [list ] .c [list ]] array set submaps [Widget::parseArgs ArrowButton $args] # Create the class frame (so we can do the option db queries) frame $path -class ArrowButton -borderwidth 0 -highlightthickness 0 Widget::initFromODB ArrowButton $path $submaps(ArrowButton) # Create the canvas with the initial options eval canvas $path.c $submaps(.c) # Compute the width and height of the canvas from the width/height # of the ArrowButton and the borderwidth/hightlightthickness. set w [Widget::getMegawidgetOption $path -width] set h [Widget::getMegawidgetOption $path -height] set bd [Widget::cget $path -borderwidth] set ht [Widget::cget $path -highlightthickness] set pad [expr {2*($bd+$ht)}] $path.c configure -width [expr {$w-$pad}] -height [expr {$h-$pad}] bindtags $path [list $path BwArrowButton [winfo toplevel $path] all] bindtags $path.c [list $path.c BwArrowButtonC [winfo toplevel $path.c] all] pack $path.c -expand yes -fill both DynamicHelp::sethelp $path $path.c 1 set ::ArrowButton::_moved($path) 0 return [Widget::create ArrowButton $path] } # ----------------------------------------------------------------------------- # Command ArrowButton::configure # ----------------------------------------------------------------------------- proc ArrowButton::configure { path args } { set res [Widget::configure $path $args] set ch1 [expr {[Widget::hasChanged $path -width w] | [Widget::hasChanged $path -height h] | [Widget::hasChanged $path -borderwidth bd] | [Widget::hasChanged $path -highlightthickness ht]}] set ch2 [expr {[Widget::hasChanged $path -type val] | [Widget::hasChanged $path -ipadx val] | [Widget::hasChanged $path -ipady val] | [Widget::hasChanged $path -arrowbd val] | [Widget::hasChanged $path -clean val] | [Widget::hasChanged $path -dir val]}] if { $ch1 } { set pad [expr {2*($bd+$ht)}] $path.c configure \ -width [expr {$w-$pad}] -height [expr {$h-$pad}] \ -borderwidth $bd -highlightthickness $ht set ch2 1 } if { $ch2 } { _redraw_whole $path [winfo width $path] [winfo height $path] } else { _redraw_relief $path _redraw_state $path } DynamicHelp::sethelp $path $path.c return $res } # ----------------------------------------------------------------------------- # Command ArrowButton::cget # ----------------------------------------------------------------------------- proc ArrowButton::cget { path option } { return [Widget::cget $path $option] } # ------------------------------------------------------------------------------ # Command ArrowButton::invoke # ------------------------------------------------------------------------------ proc ArrowButton::invoke { path } { if { ![string equal [winfo class $path] "ArrowButton"] } { set path [winfo parent $path] } if { ![string equal [Widget::getoption $path -state] "disabled"] } { set oldstate [Widget::getoption $path -state] if { [string equal [Widget::getoption $path -type] "button"] } { set oldrelief [Widget::getoption $path -relief] configure $path -state active -relief sunken } else { set oldrelief [Widget::getoption $path -arrowrelief] configure $path -state active -arrowrelief sunken } update idletasks if { [set cmd [Widget::getoption $path -armcommand]] != "" } { uplevel \#0 $cmd } after 10 if { [string equal [Widget::getoption $path -type] "button"] } { configure $path -state $oldstate -relief $oldrelief } else { configure $path -state $oldstate -arrowrelief $oldrelief } if { [set cmd [Widget::getoption $path -disarmcommand]] != "" } { uplevel \#0 $cmd } if { [set cmd [Widget::getoption $path -command]] != "" } { uplevel \#0 $cmd } } } # ------------------------------------------------------------------------------ # Command ArrowButton::_redraw # ------------------------------------------------------------------------------ proc ArrowButton::_redraw { path width height } { variable _moved set _moved($path) 0 set type [Widget::getoption $path -type] set dir [Widget::getoption $path -dir] set bd [expr {[$path.c cget -borderwidth] + [$path.c cget -highlightthickness] + 1}] set clean [Widget::getoption $path -clean] if { [string equal $type "arrow"] } { if { [set id [$path.c find withtag rect]] == "" } { $path.c create rectangle $bd $bd [expr {$width-$bd-1}] [expr {$height-$bd-1}] -tags rect } else { $path.c coords $id $bd $bd [expr {$width-$bd-1}] [expr {$height-$bd-1}] } $path.c lower rect set arrbd [Widget::getoption $path -arrowbd] set bd [expr {$bd+$arrbd-1}] } else { $path.c delete rect } # w and h are max width and max height of arrow set w [expr {$width - 2*([Widget::getoption $path -ipadx]+$bd)}] set h [expr {$height - 2*([Widget::getoption $path -ipady]+$bd)}] if { $w < 2 } {set w 2} if { $h < 2 } {set h 2} if { $clean > 0 } { # arrange for base to be odd if { [string equal $dir "top"] || [string equal $dir "bottom"] } { if { !($w % 2) } { incr w -1 } if { $clean == 2 } { # arrange for h = (w+1)/2 set h2 [expr {($w+1)/2}] if { $h2 > $h } { set w [expr {2*$h-1}] } else { set h $h2 } } } else { if { !($h % 2) } { incr h -1 } if { $clean == 2 } { # arrange for w = (h+1)/2 set w2 [expr {($h+1)/2}] if { $w2 > $w } { set h [expr {2*$w-1}] } else { set w $w2 } } } } set x0 [expr {($width-$w)/2}] set y0 [expr {($height-$h)/2}] set x1 [expr {$x0+$w-1}] set y1 [expr {$y0+$h-1}] switch $dir { top { set xd [expr {($x0+$x1)/2}] if { [set id [$path.c find withtag poly]] == "" } { $path.c create polygon $x0 $y1 $x1 $y1 $xd $y0 -tags poly } else { $path.c coords $id $x0 $y1 $x1 $y1 $xd $y0 } if { [string equal $type "arrow"] } { if { [set id [$path.c find withtag bot]] == "" } { $path.c create line $x0 $y1 $x1 $y1 $xd $y0 -tags bot } else { $path.c coords $id $x0 $y1 $x1 $y1 $xd $y0 } if { [set id [$path.c find withtag top]] == "" } { $path.c create line $x0 $y1 $xd $y0 -tags top } else { $path.c coords $id $x0 $y1 $xd $y0 } $path.c itemconfigure top -width $arrbd $path.c itemconfigure bot -width $arrbd } else { $path.c delete top $path.c delete bot } } bottom { set xd [expr {($x0+$x1)/2}] if { [set id [$path.c find withtag poly]] == "" } { $path.c create polygon $x1 $y0 $x0 $y0 $xd $y1 -tags poly } else { $path.c coords $id $x1 $y0 $x0 $y0 $xd $y1 } if { [string equal $type "arrow"] } { if { [set id [$path.c find withtag top]] == "" } { $path.c create line $x1 $y0 $x0 $y0 $xd $y1 -tags top } else { $path.c coords $id $x1 $y0 $x0 $y0 $xd $y1 } if { [set id [$path.c find withtag bot]] == "" } { $path.c create line $x1 $y0 $xd $y1 -tags bot } else { $path.c coords $id $x1 $y0 $xd $y1 } $path.c itemconfigure top -width $arrbd $path.c itemconfigure bot -width $arrbd } else { $path.c delete top $path.c delete bot } } left { set yd [expr {($y0+$y1)/2}] if { [set id [$path.c find withtag poly]] == "" } { $path.c create polygon $x1 $y0 $x1 $y1 $x0 $yd -tags poly } else { $path.c coords $id $x1 $y0 $x1 $y1 $x0 $yd } if { [string equal $type "arrow"] } { if { [set id [$path.c find withtag bot]] == "" } { $path.c create line $x1 $y0 $x1 $y1 $x0 $yd -tags bot } else { $path.c coords $id $x1 $y0 $x1 $y1 $x0 $yd } if { [set id [$path.c find withtag top]] == "" } { $path.c create line $x1 $y0 $x0 $yd -tags top } else { $path.c coords $id $x1 $y0 $x0 $yd } $path.c itemconfigure top -width $arrbd $path.c itemconfigure bot -width $arrbd } else { $path.c delete top $path.c delete bot } } right { set yd [expr {($y0+$y1)/2}] if { [set id [$path.c find withtag poly]] == "" } { $path.c create polygon $x0 $y1 $x0 $y0 $x1 $yd -tags poly } else { $path.c coords $id $x0 $y1 $x0 $y0 $x1 $yd } if { [string equal $type "arrow"] } { if { [set id [$path.c find withtag top]] == "" } { $path.c create line $x0 $y1 $x0 $y0 $x1 $yd -tags top } else { $path.c coords $id $x0 $y1 $x0 $y0 $x1 $yd } if { [set id [$path.c find withtag bot]] == "" } { $path.c create line $x0 $y1 $x1 $yd -tags bot } else { $path.c coords $id $x0 $y1 $x1 $yd } $path.c itemconfigure top -width $arrbd $path.c itemconfigure bot -width $arrbd } else { $path.c delete top $path.c delete bot } } } } # ------------------------------------------------------------------------------ # Command ArrowButton::_redraw_state # ------------------------------------------------------------------------------ proc ArrowButton::_redraw_state { path } { set state [Widget::getoption $path -state] if { [string equal [Widget::getoption $path -type] "button"] } { switch $state { normal {set bg -background; set fg -foreground} active {set bg -activebackground; set fg -activeforeground} disabled {set bg -background; set fg -disabledforeground} } set fg [Widget::getoption $path $fg] $path.c configure -background [Widget::getoption $path $bg] $path.c itemconfigure poly -fill $fg -outline $fg } else { switch $state { normal {set stipple ""; set bg [Widget::getoption $path -background] } active {set stipple ""; set bg [Widget::getoption $path -activebackground] } disabled {set stipple gray50; set bg black } } set thrc [Widget::getoption $path -troughcolor] $path.c configure -background [Widget::getoption $path -background] $path.c itemconfigure rect -fill $thrc -outline $thrc $path.c itemconfigure poly -fill $bg -outline $bg -stipple $stipple } } # ------------------------------------------------------------------------------ # Command ArrowButton::_redraw_relief # ------------------------------------------------------------------------------ proc ArrowButton::_redraw_relief { path } { variable _moved if { [string equal [Widget::getoption $path -type] "button"] } { if { [string equal [Widget::getoption $path -relief] "sunken"] } { if { !$_moved($path) } { $path.c move poly 1 1 set _moved($path) 1 } } else { if { $_moved($path) } { $path.c move poly -1 -1 set _moved($path) 0 } } } else { set col3d [BWidget::get3dcolor $path [Widget::getoption $path -background]] switch [Widget::getoption $path -arrowrelief] { raised {set top [lindex $col3d 1]; set bot [lindex $col3d 0]} sunken {set top [lindex $col3d 0]; set bot [lindex $col3d 1]} } $path.c itemconfigure top -fill $top $path.c itemconfigure bot -fill $bot } } # ------------------------------------------------------------------------------ # Command ArrowButton::_redraw_whole # ------------------------------------------------------------------------------ proc ArrowButton::_redraw_whole { path width height } { _redraw $path $width $height _redraw_relief $path _redraw_state $path } # ------------------------------------------------------------------------------ # Command ArrowButton::_enter # ------------------------------------------------------------------------------ proc ArrowButton::_enter { path } { variable _grab set path [winfo parent $path] set _grab(current) $path if { ![string equal [Widget::getoption $path -state] "disabled"] } { set _grab(oldstate) [Widget::getoption $path -state] configure $path -state active if { $_grab(pressed) == $path } { if { [string equal [Widget::getoption $path -type] "button"] } { set _grab(oldrelief) [Widget::getoption $path -relief] configure $path -relief sunken } else { set _grab(oldrelief) [Widget::getoption $path -arrowrelief] configure $path -arrowrelief sunken } } } } # ------------------------------------------------------------------------------ # Command ArrowButton::_leave # ------------------------------------------------------------------------------ proc ArrowButton::_leave { path } { variable _grab set path [winfo parent $path] set _grab(current) "" if { ![string equal [Widget::getoption $path -state] "disabled"] } { configure $path -state $_grab(oldstate) if { $_grab(pressed) == $path } { if { [string equal [Widget::getoption $path -type] "button"] } { configure $path -relief $_grab(oldrelief) } else { configure $path -arrowrelief $_grab(oldrelief) } } } } # ------------------------------------------------------------------------------ # Command ArrowButton::_press # ------------------------------------------------------------------------------ proc ArrowButton::_press { path } { variable _grab set path [winfo parent $path] if { ![string equal [Widget::getoption $path -state] "disabled"] } { set _grab(pressed) $path if { [string equal [Widget::getoption $path -type] "button"] } { set _grab(oldrelief) [Widget::getoption $path -relief] configure $path -relief sunken } else { set _grab(oldrelief) [Widget::getoption $path -arrowrelief] configure $path -arrowrelief sunken } if { [set cmd [Widget::getoption $path -armcommand]] != "" } { uplevel \#0 $cmd if { [set delay [Widget::getoption $path -repeatdelay]] > 0 || [set delay [Widget::getoption $path -repeatinterval]] > 0 } { after $delay "ArrowButton::_repeat $path" } } } } # ------------------------------------------------------------------------------ # Command ArrowButton::_release # ------------------------------------------------------------------------------ proc ArrowButton::_release { path } { variable _grab set path [winfo parent $path] if { $_grab(pressed) == $path } { set _grab(pressed) "" if { [string equal [Widget::getoption $path -type] "button"] } { configure $path -relief $_grab(oldrelief) } else { configure $path -arrowrelief $_grab(oldrelief) } if { [set cmd [Widget::getoption $path -disarmcommand]] != "" } { uplevel \#0 $cmd } if { $_grab(current) == $path && ![string equal [Widget::getoption $path -state] "disabled"] && [set cmd [Widget::getoption $path -command]] != "" } { uplevel \#0 $cmd } } } # ------------------------------------------------------------------------------ # Command ArrowButton::_repeat # ------------------------------------------------------------------------------ proc ArrowButton::_repeat { path } { variable _grab if { $_grab(current) == $path && $_grab(pressed) == $path && ![string equal [Widget::getoption $path -state] "disabled"] && [set cmd [Widget::getoption $path -armcommand]] != "" } { uplevel \#0 $cmd } if { $_grab(pressed) == $path && ([set delay [Widget::getoption $path -repeatinterval]] > 0 || [set delay [Widget::getoption $path -repeatdelay]] > 0) } { after $delay "ArrowButton::_repeat $path" } } # ------------------------------------------------------------------------------ # Command ArrowButton::_destroy # ------------------------------------------------------------------------------ proc ArrowButton::_destroy { path } { variable _moved Widget::destroy $path unset _moved($path) } astk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/bitmap.tcl0000644004705000470430000000514412161053524021334 0ustar courtoisasterdev# ------------------------------------------------------------------------------ # bitmap.tcl # This file is part of Unifix BWidget Toolkit # $Id: bitmap.tcl 606 2004-04-05 07:06:06Z mcourtoi $ # ------------------------------------------------------------------------------ # Index of commands: # - Bitmap::get # - Bitmap::_init # ---------------------------------------------------------------------------- namespace eval Bitmap { Widget::define Bitmap bitmap -classonly variable path variable _bmp variable _types { photo .gif photo .ppm bitmap .xbm photo .xpm } proc use {} {} } # ---------------------------------------------------------------------------- # Command Bitmap::get # ---------------------------------------------------------------------------- proc Bitmap::get { name } { variable path variable _bmp variable _types if {[info exists _bmp($name)]} { return $_bmp($name) } # --- Nom de fichier avec extension --------------------------------- set ext [file extension $name] if { $ext != "" } { if { ![info exists _bmp($ext)] } { error "$ext not supported" } if { [file exists $name] } { if {[string equal $ext ".xpm"]} { set _bmp($name) [xpm-to-image $name] return $_bmp($name) } if {![catch {set _bmp($name) [image create $_bmp($ext) -file $name]}]} { return $_bmp($name) } } } foreach dir $path { foreach {type ext} $_types { if { [file exists [file join $dir $name$ext]] } { if {[string equal $ext ".xpm"]} { set _bmp($name) [xpm-to-image [file join $dir $name$ext]] return $_bmp($name) } else { if {![catch {set _bmp($name) [image create $type -file [file join $dir $name$ext]]}]} { return $_bmp($name) } } } } } return -code error "$name not found" } # ---------------------------------------------------------------------------- # Command Bitmap::_init # ---------------------------------------------------------------------------- proc Bitmap::_init { } { global env variable path variable _bmp variable _types set path [list "." [file join $::BWIDGET::LIBRARY images]] set supp [image types] foreach {type ext} $_types { if { [lsearch $supp $type] != -1} { set _bmp($ext) $type } } } Bitmap::_init astk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/button.tcl0000644004705000470430000002567712161053524021410 0ustar courtoisasterdev# ---------------------------------------------------------------------------- # button.tcl # This file is part of Unifix BWidget Toolkit # ---------------------------------------------------------------------------- # Index of commands: # Public commands # - Button::create # - Button::configure # - Button::cget # - Button::invoke # Private commands (event bindings) # - Button::_destroy # - Button::_enter # - Button::_leave # - Button::_press # - Button::_release # - Button::_repeat # ---------------------------------------------------------------------------- namespace eval Button { Widget::define Button button DynamicHelp set remove [list -command -relief -text -textvariable -underline -state] if {[info tclversion] > 8.3} { lappend remove -repeatdelay -repeatinterval } Widget::tkinclude Button button :cmd remove $remove Widget::declare Button { {-name String "" 0} {-text String "" 0} {-textvariable String "" 0} {-underline Int -1 0 "%d >= -1"} {-armcommand String "" 0} {-disarmcommand String "" 0} {-command String "" 0} {-state TkResource "" 0 button} {-repeatdelay Int 0 0 "%d >= 0"} {-repeatinterval Int 0 0 "%d >= 0"} {-relief Enum raised 0 {raised sunken flat ridge solid groove link}} } DynamicHelp::include Button balloon Widget::syncoptions Button "" :cmd {-text {} -underline {}} variable _current "" variable _pressed "" bind BwButton {Button::_enter %W} bind BwButton {Button::_leave %W} bind BwButton {Button::_press %W} bind BwButton {Button::_release %W} bind BwButton {Button::invoke %W; break} bind BwButton {Button::invoke %W; break} bind BwButton {Widget::destroy %W} } # ---------------------------------------------------------------------------- # Command Button::create # ---------------------------------------------------------------------------- proc Button::create { path args } { array set maps [list Button {} :cmd {}] array set maps [Widget::parseArgs Button $args] eval [concat [list button $path] $maps(:cmd)] Widget::initFromODB Button $path $maps(Button) # Do some extra configuration on the button set relief [Widget::getMegawidgetOption $path -relief] if { [string equal $relief "link"] } { set relief "flat" } set var [Widget::getMegawidgetOption $path -textvariable] set st [Widget::getMegawidgetOption $path -state] if { ![string length $var] } { set desc [BWidget::getname [Widget::getMegawidgetOption $path -name]] if { [llength $desc] } { set text [lindex $desc 0] set under [lindex $desc 1] Widget::configure $path [list -text $text] Widget::configure $path [list -underline $under] } else { set text [Widget::getMegawidgetOption $path -text] set under [Widget::getMegawidgetOption $path -underline] } } else { set under -1 set text "" Widget::configure $path [list -underline $under] } $path configure -relief $relief -text $text -underline $under \ -textvariable $var -state $st bindtags $path [list $path BwButton [winfo toplevel $path] all] set accel1 [string tolower [string index $text $under]] set accel2 [string toupper $accel1] if { $accel1 != "" } { bind [winfo toplevel $path] [list Button::invoke $path] bind [winfo toplevel $path] [list Button::invoke $path] } DynamicHelp::sethelp $path $path 1 return [Widget::create Button $path] } # ---------------------------------------------------------------------------- # Command Button::configure # ---------------------------------------------------------------------------- proc Button::configure { path args } { set oldunder [$path:cmd cget -underline] if { $oldunder != -1 } { set oldaccel1 [string tolower [string index [$path:cmd cget -text] $oldunder]] set oldaccel2 [string toupper $oldaccel1] } else { set oldaccel1 "" set oldaccel2 "" } set res [Widget::configure $path $args] # Extract all the modified bits we're interested in foreach {cr cs cv cn ct cu} [Widget::hasChangedX $path \ -relief -state -textvariable -name -text -underline] break if { $cr || $cs } { set relief [Widget::cget $path -relief] set state [Widget::cget $path -state] if { [string equal $relief "link"] } { if { [string equal $state "active"] } { set relief "raised" } else { set relief "flat" } } $path:cmd configure -relief $relief -state $state } if { $cv || $cn || $ct || $cu } { set var [Widget::cget $path -textvariable] set text [Widget::cget $path -text] set under [Widget::cget $path -underline] if { ![string length $var] } { set desc [BWidget::getname [Widget::cget $path -name]] if { [llength $desc] } { set text [lindex $desc 0] set under [lindex $desc 1] } } else { set under -1 set text "" } set top [winfo toplevel $path] if { $oldaccel1 != "" } { bind $top {} bind $top {} } set accel1 [string tolower [string index $text $under]] set accel2 [string toupper $accel1] if { $accel1 != "" } { bind $top [list Button::invoke $path] bind $top [list Button::invoke $path] } $path:cmd configure -text $text -underline $under -textvariable $var } DynamicHelp::sethelp $path $path set res } # ---------------------------------------------------------------------------- # Command Button::cget # ---------------------------------------------------------------------------- proc Button::cget { path option } { Widget::cget $path $option } # ---------------------------------------------------------------------------- # Command Button::invoke # ---------------------------------------------------------------------------- proc Button::invoke { path } { if { ![string equal [$path:cmd cget -state] "disabled"] } { $path:cmd configure -state active -relief sunken update idletasks set cmd [Widget::getMegawidgetOption $path -armcommand] if { $cmd != "" } { uplevel \#0 $cmd } after 100 set relief [Widget::getMegawidgetOption $path -relief] if { [string equal $relief "link"] } { set relief flat } $path:cmd configure \ -state [Widget::getMegawidgetOption $path -state] \ -relief $relief set cmd [Widget::getMegawidgetOption $path -disarmcommand] if { $cmd != "" } { uplevel \#0 $cmd } set cmd [Widget::getMegawidgetOption $path -command] if { $cmd != "" } { uplevel \#0 $cmd } } } # ---------------------------------------------------------------------------- # Command Button::_enter # ---------------------------------------------------------------------------- proc Button::_enter { path } { variable _current variable _pressed set _current $path if { ![string equal [$path:cmd cget -state] "disabled"] } { $path:cmd configure -state active if { $_pressed == $path } { $path:cmd configure -relief sunken } elseif { [string equal [Widget::cget $path -relief] "link"] } { $path:cmd configure -relief raised } } } # ---------------------------------------------------------------------------- # Command Button::_leave # ---------------------------------------------------------------------------- proc Button::_leave { path } { variable _current variable _pressed set _current "" if { ![string equal [$path:cmd cget -state] "disabled"] } { $path:cmd configure -state [Widget::cget $path -state] set relief [Widget::cget $path -relief] if { $_pressed == $path } { if { [string equal $relief "link"] } { set relief raised } $path:cmd configure -relief $relief } elseif { [string equal $relief "link"] } { $path:cmd configure -relief flat } } } # ---------------------------------------------------------------------------- # Command Button::_press # ---------------------------------------------------------------------------- proc Button::_press { path } { variable _pressed if { ![string equal [$path:cmd cget -state] "disabled"] } { set _pressed $path $path:cmd configure -relief sunken set cmd [Widget::getMegawidgetOption $path -armcommand] if { $cmd != "" } { uplevel \#0 $cmd set repeatdelay [Widget::getMegawidgetOption $path -repeatdelay] set repeatint [Widget::getMegawidgetOption $path -repeatinterval] if { $repeatdelay > 0 } { after $repeatdelay "Button::_repeat $path" } elseif { $repeatint > 0 } { after $repeatint "Button::_repeat $path" } } } } # ---------------------------------------------------------------------------- # Command Button::_release # ---------------------------------------------------------------------------- proc Button::_release { path } { variable _current variable _pressed if { $_pressed == $path } { set _pressed "" set relief [Widget::getMegawidgetOption $path -relief] after cancel "Button::_repeat $path" if { [string equal $relief "link"] } { set relief raised } $path:cmd configure -relief $relief set cmd [Widget::getMegawidgetOption $path -disarmcommand] if { $cmd != "" } { uplevel \#0 $cmd } if { $_current == $path && ![string equal [$path:cmd cget -state] "disabled"] && \ [set cmd [Widget::getMegawidgetOption $path -command]] != "" } { uplevel \#0 $cmd } } } # ---------------------------------------------------------------------------- # Command Button::_repeat # ---------------------------------------------------------------------------- proc Button::_repeat { path } { variable _current variable _pressed if { $_current == $path && $_pressed == $path && ![string equal [$path:cmd cget -state] "disabled"] && [set cmd [Widget::getMegawidgetOption $path -armcommand]] != "" } { uplevel \#0 $cmd } if { $_pressed == $path && ([set delay [Widget::getMegawidgetOption $path -repeatinterval]] >0 || [set delay [Widget::getMegawidgetOption $path -repeatdelay]] > 0) } { after $delay "Button::_repeat $path" } } astk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/buttonbox.tcl0000644004705000470430000002657012161053524022112 0ustar courtoisasterdev# ---------------------------------------------------------------------------- # buttonbox.tcl # This file is part of Unifix BWidget Toolkit # ---------------------------------------------------------------------------- # Index of commands: # - ButtonBox::create # - ButtonBox::configure # - ButtonBox::cget # - ButtonBox::add # - ButtonBox::itemconfigure # - ButtonBox::itemcget # - ButtonBox::setfocus # - ButtonBox::invoke # - ButtonBox::index # - ButtonBox::_destroy # ---------------------------------------------------------------------------- namespace eval ButtonBox { Widget::define ButtonBox buttonbox Button Widget::declare ButtonBox { {-background TkResource "" 0 frame} {-orient Enum horizontal 1 {horizontal vertical}} {-state Enum "normal" 0 {normal disabled}} {-homogeneous Boolean 1 1} {-spacing Int 10 0 "%d >= 0"} {-padx TkResource "" 0 button} {-pady TkResource "" 0 button} {-default Int -1 0 "%d >= -1"} {-bg Synonym -background} } Widget::addmap ButtonBox "" :cmd {-background {}} bind ButtonBox [list ButtonBox::_destroy %W] } # ---------------------------------------------------------------------------- # Command ButtonBox::create # ---------------------------------------------------------------------------- proc ButtonBox::create { path args } { Widget::init ButtonBox $path $args variable $path upvar 0 $path data eval [list frame $path] [Widget::subcget $path :cmd] \ [list -class ButtonBox -takefocus 0 -highlightthickness 0] # For 8.4+ we don't want to inherit the padding catch {$path configure -padx 0 -pady 0} set data(max) 0 set data(nbuttons) 0 set data(buttons) [list] set data(default) [Widget::getoption $path -default] return [Widget::create ButtonBox $path] } # ---------------------------------------------------------------------------- # Command ButtonBox::configure # ---------------------------------------------------------------------------- proc ButtonBox::configure { path args } { variable $path upvar 0 $path data set res [Widget::configure $path $args] if { [Widget::hasChanged $path -default val] } { if { $data(default) != -1 && $val != -1 } { set but $path.b$data(default) if { [winfo exists $but] } { $but configure -default normal } set but $path.b$val if { [winfo exists $but] } { $but configure -default active } set data(default) $val } else { Widget::setoption $path -default $data(default) } } if {[Widget::hasChanged $path -state val]} { foreach i $data(buttons) { $path.b$i configure -state $val } } return $res } # ---------------------------------------------------------------------------- # Command ButtonBox::cget # ---------------------------------------------------------------------------- proc ButtonBox::cget { path option } { return [Widget::cget $path $option] } # ---------------------------------------------------------------------------- # Command ButtonBox::add # ---------------------------------------------------------------------------- proc ButtonBox::add { path args } { return [eval insert $path end $args] } proc ButtonBox::insert { path idx args } { variable $path upvar 0 $path data set but $path.b$data(nbuttons) set spacing [Widget::getoption $path -spacing] ## Save the current spacing setting for this button. Buttons ## appended to the end of the box have their spacing applied ## to their left while all other have their spacing applied ## to their right. if {$idx == "end"} { set data(spacing,$data(nbuttons)) [list left $spacing] lappend data(buttons) $data(nbuttons) } else { set data(spacing,$data(nbuttons)) [list right $spacing] set data(buttons) [linsert $data(buttons) $idx $data(nbuttons)] } if { $data(nbuttons) == $data(default) } { set style active } elseif { $data(default) == -1 } { set style disabled } else { set style normal } array set flags $args set tags "" if { [info exists flags(-tags)] } { set tags $flags(-tags) unset flags(-tags) set args [array get flags] } eval [list Button::create $but \ -background [Widget::getoption $path -background]\ -padx [Widget::getoption $path -padx] \ -pady [Widget::getoption $path -pady]] \ $args [list -default $style] # ericm@scriptics.com: set up tags, just like the menu items foreach tag $tags { lappend data(tags,$tag) $but if { ![info exists data(tagstate,$tag)] } { set data(tagstate,$tag) 0 } } set data(buttontags,$but) $tags # ericm@scriptics.com _redraw $path incr data(nbuttons) return $but } proc ButtonBox::delete { path idx } { variable $path upvar 0 $path data set i [lindex $data(buttons) $idx] set data(buttons) [lreplace $data(buttons) $idx $idx] destroy $path.b$i } # ButtonBox::setbuttonstate -- # # Set the state of a given button tag. If this makes any buttons # enable-able (ie, all of their tags are TRUE), enable them. # # Arguments: # path the button box widget name # tag the tag to modify # state the new state of $tag (0 or 1) # # Results: # None. proc ButtonBox::setbuttonstate {path tag state} { variable $path upvar 0 $path data # First see if this is a real tag if { [info exists data(tagstate,$tag)] } { set data(tagstate,$tag) $state foreach but $data(tags,$tag) { set expression "1" foreach buttontag $data(buttontags,$but) { append expression " && $data(tagstate,$buttontag)" } if { [expr $expression] } { set state normal } else { set state disabled } $but configure -state $state } } return } # ButtonBox::getbuttonstate -- # # Retrieve the state of a given button tag. # # Arguments: # path the button box widget name # tag the tag to modify # # Results: # None. proc ButtonBox::getbuttonstate {path tag} { variable $path upvar 0 $path data # First see if this is a real tag if { [info exists data(tagstate,$tag)] } { return $data(tagstate,$tag) } else { error "unknown tag $tag" } } # ---------------------------------------------------------------------------- # Command ButtonBox::itemconfigure # ---------------------------------------------------------------------------- proc ButtonBox::itemconfigure { path index args } { if { [set idx [lsearch $args -default]] != -1 } { set args [lreplace $args $idx [expr {$idx+1}]] } return [eval [list Button::configure $path.b[index $path $index]] $args] } # ---------------------------------------------------------------------------- # Command ButtonBox::itemcget # ---------------------------------------------------------------------------- proc ButtonBox::itemcget { path index option } { return [Button::cget $path.b[index $path $index] $option] } # ---------------------------------------------------------------------------- # Command ButtonBox::setfocus # ---------------------------------------------------------------------------- proc ButtonBox::setfocus { path index } { set but $path.b[index $path $index] if { [winfo exists $but] } { focus $but } } # ---------------------------------------------------------------------------- # Command ButtonBox::invoke # ---------------------------------------------------------------------------- proc ButtonBox::invoke { path index } { set but $path.b[index $path $index] if { [winfo exists $but] } { Button::invoke $but } } # ---------------------------------------------------------------------------- # Command ButtonBox::index # ---------------------------------------------------------------------------- proc ButtonBox::index { path index } { variable $path upvar 0 $path data set n [expr {$data(nbuttons) - 1}] if {[string equal $index "default"]} { set res [Widget::getoption $path -default] } elseif {$index == "end" || $index == "last"} { set res $n } elseif {![string is integer $index]} { ## It's not an integer. Search the text of each button ## in the box and return the index that matches. foreach i $data(buttons) { set w $path.b$i lappend text [$w cget -text] lappend names [$w cget -name] } set res [lsearch -exact [concat $names $text] $index] } else { set res $index if {$index > $n} { set res $n } } return $res } # ButtonBox::gettags -- # # Return a list of all the tags on all the buttons in a buttonbox. # # Arguments: # path the buttonbox to query. # # Results: # taglist a list of tags on the buttons in the buttonbox proc ButtonBox::gettags {path} { upvar ::ButtonBox::$path data set taglist {} foreach tag [array names data "tags,*"] { lappend taglist [string range $tag 5 end] } return $taglist } # ---------------------------------------------------------------------------- # Command ButtonBox::_redraw # ---------------------------------------------------------------------------- proc ButtonBox::_redraw { path } { variable $path upvar 0 $path data Widget::getVariable $path buttons ## We re-grid the buttons from left-to-right. As we go through ## each button, we check its spacing and which direction the ## spacing applies to. Once spacing has been applied to an index, ## it is not changed. This means spacing takes precedence from ## left-to-right. set idx 0 set idxs [list] foreach i $data(buttons) { set dir [lindex $data(spacing,$i) 0] set spacing [lindex $data(spacing,$i) 1] set but $path.b$i if {[string equal [Widget::getoption $path -orient] "horizontal"]} { grid $but -column $idx -row 0 -sticky nsew if { [Widget::getoption $path -homogeneous] } { set req [winfo reqwidth $but] if { $req > $data(max) } { grid columnconfigure $path [expr {2*$i}] -minsize $req set data(max) $req } grid columnconfigure $path $idx -minsize $data(max) -weight 1 } else { grid columnconfigure $path $idx -weight 0 } set col [expr {$idx - 1}] if {[string equal $dir "right"]} { set col [expr {$idx + 1}] } if {$col > 0 && [lsearch $idxs $col] < 0} { lappend idxs $col grid columnconfigure $path $col -minsize $spacing } } else { grid $but -column 0 -row $idx -sticky nsew grid rowconfigure $path $idx -weight 0 set row [expr {$idx - 1}] if {[string equal $dir "right"]} { set row [expr {$idx + 1}] } if {$row > 0 && [lsearch $idxs $row] < 0} { lappend idxs $row grid rowconfigure $path $row -minsize $spacing } } incr idx 2 } } # ---------------------------------------------------------------------------- # Command ButtonBox::_destroy # ---------------------------------------------------------------------------- proc ButtonBox::_destroy { path } { variable $path upvar 0 $path data Widget::destroy $path unset data } astk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/color.tcl0000644004705000470430000003363312161053524021202 0ustar courtoisasterdevnamespace eval SelectColor { Widget::define SelectColor color Dialog Widget::declare SelectColor { {-title String "Select a color" 0} {-parent String "" 0} {-color TkResource "" 0 {label -background}} {-type Enum "dialog" 1 {dialog popup}} {-placement String "center" 1} } variable _baseColors { \#0000ff \#00ff00 \#00ffff \#ff0000 \#ff00ff \#ffff00 \#000099 \#009900 \#009999 \#990000 \#990099 \#999900 \#000000 \#333333 \#666666 \#999999 \#cccccc \#ffffff } variable _userColors { \#ffffff \#ffffff \#ffffff \#ffffff \#ffffff \#ffffff \#ffffff \#ffffff \#ffffff \#ffffff \#ffffff } if {[string equal $::tcl_platform(platform) "unix"]} { set useTkDialogue 0 } else { set useTkDialogue 1 } variable _selectype variable _selection variable _wcolor variable _image variable _hsv } proc SelectColor::create { path args } { Widget::init SelectColor $path $args set type [Widget::cget $path -type] switch -- [Widget::cget $path -type] { "dialog" { return [eval [list SelectColor::dialog $path] $args] } "popup" { set list [list at center left right above below] set placement [Widget::cget $path -placement] set where [lindex $placement 0] if {[lsearch $list $where] < 0} { return -code error \ [BWidget::badOptionString placement $placement $list] } ## If they specified a parent and didn't pass a second argument ## in the placement, set the placement relative to the parent. set parent [Widget::cget $path -parent] if {[string length $parent]} { if {[llength $placement] == 1} { lappend placement $parent } } return [eval [list SelectColor::menu $path $placement] $args] } } } proc SelectColor::menu {path placement args} { variable _baseColors variable _userColors variable _wcolor variable _selectype variable _selection Widget::init SelectColor $path $args set top [::menu $path] wm withdraw $top wm transient $top [winfo toplevel [winfo parent $top]] set frame [frame $top.frame \ -highlightthickness 0 \ -relief raised -borderwidth 2] set col 0 set row 0 set count 0 set colors [concat $_baseColors $_userColors] foreach color $colors { set f [frame $frame.c$count \ -highlightthickness 1 \ -highlightcolor white \ -relief solid -borderwidth 1 \ -width 16 -height 16 -background $color] bind $f [list set SelectColor::_selection $count] bind $f {focus %W} grid $f -column $col -row $row -padx 1 -pady 1 bindtags $f $f incr count if {[incr col] == 6 } { set col 0 incr row } } set f [label $frame.c$count \ -highlightthickness 1 \ -highlightcolor white \ -relief flat -borderwidth 0 \ -width 16 -height 16 -image [Bitmap::get palette]] grid $f -column $col -row $row -padx 1 -pady 1 bind $f [list set SelectColor::_selection $count] bind $f {focus %W} pack $frame bind $frame {set SelectColor::_selection -1} bind $frame {set SelectColor::_selection -2} eval [list BWidget::place $top 0 0] $placement wm deiconify $top raise $top if {$::tcl_platform(platform) == "unix"} { tkwait visibility $top update } focus -force $frame BWidget::grab set $frame tkwait variable SelectColor::_selection update BWidget::grab release $frame destroy $top update Widget::destroy $top if {$_selection == $count} { return [eval [list dialog $path] $args] } else { return [lindex $colors $_selection] } } proc SelectColor::dialog {path args} { variable _baseColors variable _userColors variable _widget variable _selection variable _image variable _hsv Widget::init SelectColor $path:SelectColor $args set top [Dialog::create $path \ -title [Widget::cget $path:SelectColor -title] \ -parent [Widget::cget $path:SelectColor -parent] \ -separator 1 -default 0 -cancel 1] wm resizable $top 0 0 set dlgf [$top getframe] set fg [frame $dlgf.fg] set desc [list \ base _baseColors "Base colors" \ user _userColors "User colors"] set count 0 foreach {type varcol defTitle} $desc { set col 0 set lin 0 set title [lindex [BWidget::getname "${type}Colors"] 0] if {![string length $title]} { set title $defTitle } set titf [TitleFrame $fg.$type -text $title] set subf [$titf getframe] foreach color [set $varcol] { set fround [frame $fg.round$count \ -highlightthickness 1 \ -relief sunken -borderwidth 2] set fcolor [frame $fg.color$count -width 16 -height 12 \ -highlightthickness 0 \ -relief flat -borderwidth 0 \ -background $color] pack $fcolor -in $fround grid $fround -in $subf -row $lin -column $col -padx 1 -pady 1 bind $fround [list SelectColor::_select_rgb $count] bind $fcolor [list SelectColor::_select_rgb $count] bind $fround \ "SelectColor::_select_rgb [list $count]; [list $top] invoke 0" bind $fcolor \ "SelectColor::_select_rgb [list $count]; [list $top] invoke 0" incr count if {[incr col] == 6} { incr lin set col 0 } } pack $titf -anchor w -pady 2 } set fround [frame $fg.round \ -highlightthickness 0 \ -relief sunken -borderwidth 2] set fcolor [frame $fg.color \ -width 50 \ -highlightthickness 0 \ -relief flat -borderwidth 0] pack $fcolor -in $fround -fill y -expand yes pack $fround -anchor e -pady 2 -fill y -expand yes set fd [frame $dlgf.fd] set f1 [frame $fd.f1 -relief sunken -borderwidth 2] set f2 [frame $fd.f2 -relief sunken -borderwidth 2] set c1 [canvas $f1.c -width 200 -height 200 -bd 0 -highlightthickness 0] set c2 [canvas $f2.c -width 15 -height 200 -bd 0 -highlightthickness 0] for {set val 0} {$val < 40} {incr val} { $c2 create rectangle 0 [expr {5*$val}] 15 [expr {5*$val+5}] -tags val[expr {39-$val}] } $c2 create polygon 0 0 10 5 0 10 -fill black -outline white -tags target pack $c1 $c2 pack $f1 $f2 -side left -padx 10 -anchor n pack $fg $fd -side left -anchor n -fill y bind $c1 [list SelectColor::_select_hue_sat %x %y] bind $c1 [list SelectColor::_select_hue_sat %x %y] bind $c2 [list SelectColor::_select_value %x %y] bind $c2 [list SelectColor::_select_value %x %y] if {![info exists _image] || [catch {image type $_image}]} { set _image [image create photo -width 200 -height 200] for {set x 0} {$x < 200} {incr x 4} { for {set y 0} {$y < 200} {incr y 4} { $_image put \ [eval [list format "\#%04x%04x%04x"] \ [hsvToRgb [expr {$x/196.0}] [expr {(196-$y)/196.0}] 0.85]] \ -to $x $y [expr {$x+4}] [expr {$y+4}] } } } $c1 create image 0 0 -anchor nw -image $_image $c1 create bitmap 0 0 \ -bitmap @[file join $::BWIDGET::LIBRARY "images" "target.xbm"] \ -anchor nw -tags target set _selection -1 set _widget(fcolor) $fg set _widget(chs) $c1 set _widget(cv) $c2 set rgb [winfo rgb $path [Widget::cget $path:SelectColor -color]] set _hsv [eval rgbToHsv $rgb] _set_rgb [eval format "\#%04x%04x%04x" $rgb] _set_hue_sat [lindex $_hsv 0] [lindex $_hsv 1] _set_value [lindex $_hsv 2] $top add -name ok $top add -name cancel set res [$top draw] if {$res == 0} { set color [$fg.color cget -background] } else { set color "" } destroy $top return $color } proc SelectColor::setcolor { idx color } { variable _userColors set _userColors [lreplace $_userColors $idx $idx $color] } proc SelectColor::_select_rgb {count} { variable _baseColors variable _userColors variable _selection variable _widget variable _hsv set frame $_widget(fcolor) if {$_selection >= 0} { $frame.round$_selection configure \ -relief sunken -highlightthickness 1 -borderwidth 2 } $frame.round$count configure \ -relief flat -highlightthickness 2 -borderwidth 1 focus $frame.round$count set _selection $count set bg [$frame.color$count cget -background] set user [expr {$_selection-[llength $_baseColors]}] if {$user >= 0 && [string equal \ [winfo rgb $frame.color$_selection $bg] \ [winfo rgb $frame.color$_selection white]]} { set bg [$frame.color cget -bg] $frame.color$_selection configure -background $bg set _userColors [lreplace $_userColors $user $user $bg] } else { set _hsv [eval rgbToHsv [winfo rgb $frame.color$count $bg]] _set_hue_sat [lindex $_hsv 0] [lindex $_hsv 1] _set_value [lindex $_hsv 2] $frame.color configure -background $bg } } proc SelectColor::_set_rgb {rgb} { variable _selection variable _baseColors variable _userColors variable _widget set frame $_widget(fcolor) $frame.color configure -background $rgb set user [expr {$_selection-[llength $_baseColors]}] if {$user >= 0} { $frame.color$_selection configure -background $rgb set _userColors [lreplace $_userColors $user $user $rgb] } } proc SelectColor::_select_hue_sat {x y} { variable _widget variable _hsv if {$x < 0} { set x 0 } elseif {$x > 200} { set x 200 } if {$y < 0 } { set y 0 } elseif {$y > 200} { set y 200 } set hue [expr {$x/200.0}] set sat [expr {(200-$y)/200.0}] set _hsv [lreplace $_hsv 0 1 $hue $sat] $_widget(chs) coords target [expr {$x-9}] [expr {$y-9}] _draw_values $hue $sat _set_rgb [eval [list format "\#%04x%04x%04x"] [eval [list hsvToRgb] $_hsv]] } proc SelectColor::_set_hue_sat {hue sat} { variable _widget set x [expr {$hue*200-9}] set y [expr {(1-$sat)*200-9}] $_widget(chs) coords target $x $y _draw_values $hue $sat } proc SelectColor::_select_value {x y} { variable _widget variable _hsv if {$y < 0} { set y 0 } elseif {$y > 200} { set y 200 } $_widget(cv) coords target 0 [expr {$y-5}] 10 $y 0 [expr {$y+5}] set _hsv [lreplace $_hsv 2 2 [expr {(200-$y)/200.0}]] _set_rgb [eval [list format "\#%04x%04x%04x"] [eval [list hsvToRgb] $_hsv]] } proc SelectColor::_draw_values {hue sat} { variable _widget for {set val 0} {$val < 40} {incr val} { set l [hsvToRgb $hue $sat [expr {$val/39.0}]] set col [eval [list format "\#%04x%04x%04x"] $l] $_widget(cv) itemconfigure val$val -fill $col -outline $col } } proc SelectColor::_set_value {value} { variable _widget set y [expr {int((1-$value)*200)}] $_widget(cv) coords target 0 [expr {$y-5}] 10 $y 0 [expr {$y+5}] } # -- # Taken from tk8.0/demos/tcolor.tcl # -- # The procedure below converts an HSB value to RGB. It takes hue, saturation, # and value components (floating-point, 0-1.0) as arguments, and returns a # list containing RGB components (integers, 0-65535) as result. The code # here is a copy of the code on page 616 of "Fundamentals of Interactive # Computer Graphics" by Foley and Van Dam. proc SelectColor::hsvToRgb {hue sat val} { set v [expr {round(65535.0*$val)}] if {$sat == 0} { return [list $v $v $v] } else { set hue [expr {$hue*6.0}] if {$hue >= 6.0} { set hue 0.0 } set i [expr {int($hue)}] set f [expr {$hue-$i}] set p [expr {round(65535.0*$val*(1 - $sat))}] set q [expr {round(65535.0*$val*(1 - ($sat*$f)))}] set t [expr {round(65535.0*$val*(1 - ($sat*(1 - $f))))}] switch $i { 0 {return [list $v $t $p]} 1 {return [list $q $v $p]} 2 {return [list $p $v $t]} 3 {return [list $p $q $v]} 4 {return [list $t $p $v]} 5 {return [list $v $p $q]} } } } # -- # Taken from tk8.0/demos/tcolor.tcl # -- # The procedure below converts an RGB value to HSB. It takes red, green, # and blue components (0-65535) as arguments, and returns a list containing # HSB components (floating-point, 0-1) as result. The code here is a copy # of the code on page 615 of "Fundamentals of Interactive Computer Graphics" # by Foley and Van Dam. proc SelectColor::rgbToHsv {red green blue} { if {$red > $green} { set max $red.0 set min $green.0 } else { set max $green.0 set min $red.0 } if {$blue > $max} { set max $blue.0 } else { if {$blue < $min} { set min $blue.0 } } set range [expr {$max-$min}] if {$max == 0} { set sat 0 } else { set sat [expr {($max-$min)/$max}] } if {$sat == 0} { set hue 0 } else { set rc [expr {($max - $red)/$range}] set gc [expr {($max - $green)/$range}] set bc [expr {($max - $blue)/$range}] if {$red == $max} { set hue [expr {.166667*($bc - $gc)}] } else { if {$green == $max} { set hue [expr {.166667*(2 + $rc - $bc)}] } else { set hue [expr {.166667*(4 + $gc - $rc)}] } } if {$hue < 0.0} { set hue [expr {$hue + 1.0}] } } return [list $hue $sat [expr {$max/65535}]] } astk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/combobox.tcl0000644004705000470430000005426512161053524021700 0ustar courtoisasterdev# ---------------------------------------------------------------------------- # combobox.tcl # This file is part of Unifix BWidget Toolkit # $Id: combobox.tcl 606 2004-04-05 07:06:06Z mcourtoi $ # ---------------------------------------------------------------------------- # Index of commands: # - ComboBox::create # - ComboBox::configure # - ComboBox::cget # - ComboBox::setvalue # - ComboBox::getvalue # - ComboBox::_create_popup # - ComboBox::_mapliste # - ComboBox::_unmapliste # - ComboBox::_select # - ComboBox::_modify_value # ---------------------------------------------------------------------------- # ComboBox uses the 8.3 -listvariable listbox option package require Tk 8.3 namespace eval ComboBox { Widget::define ComboBox combobox ArrowButton Entry ListBox Widget::tkinclude ComboBox frame :cmd \ include {-relief -borderwidth -bd -background} \ initialize {-relief sunken -borderwidth 2} \ Widget::bwinclude ComboBox Entry .e \ remove {-relief -bd -borderwidth -bg} \ rename {-background -entrybg} Widget::declare ComboBox { {-height TkResource 0 0 listbox} {-values String "" 0} {-images String "" 0} {-indents String "" 0} {-modifycmd String "" 0} {-postcommand String "" 0} {-expand Enum none 0 {none tab}} {-autocomplete Boolean 0 0} {-bwlistbox Boolean 0 0} {-listboxwidth Int 0 0} {-hottrack Boolean 0 0} } Widget::addmap ComboBox ArrowButton .a { -background {} -foreground {} -disabledforeground {} -state {} } Widget::syncoptions ComboBox Entry .e {-text {}} ::bind BwComboBox [list after idle {BWidget::refocus %W %W.e}] ::bind BwComboBox [list Widget::destroy %W] ::bind ListBoxHotTrack { %W selection clear 0 end %W activate @%x,%y %W selection set @%x,%y } } # ComboBox::create -- # # Create a combobox widget with the given options. # # Arguments: # path name of the new widget. # args optional arguments to the widget. # # Results: # path name of the new widget. proc ComboBox::create { path args } { array set maps [list ComboBox {} :cmd {} .e {} .a {}] array set maps [Widget::parseArgs ComboBox $args] eval [list frame $path] $maps(:cmd) \ [list -highlightthickness 0 -takefocus 0 -class ComboBox] Widget::initFromODB ComboBox $path $maps(ComboBox) bindtags $path [list $path BwComboBox [winfo toplevel $path] all] set entry [eval [list Entry::create $path.e] $maps(.e) \ [list -relief flat -borderwidth 0 -takefocus 1]] ::bind $path.e [list $path _focus_out] ::bind $path <> [list $path _traverse_in] if {[Widget::cget $path -autocomplete]} { ::bind $path.e [list $path _auto_complete %K] } if {[string equal $::tcl_platform(platform) "unix"]} { set ipadx 0 set width 11 } else { set ipadx 2 set width 15 } set height [winfo reqheight $entry] set arrow [eval [list ArrowButton::create $path.a] $maps(.a) \ -width $width -height $height \ -highlightthickness 0 -borderwidth 1 -takefocus 0 \ -dir bottom \ -type button \ -ipadx $ipadx \ -command [list [list ComboBox::_mapliste $path]]] pack $arrow -side right -fill y pack $entry -side left -fill both -expand yes set editable [Widget::cget $path -editable] Entry::configure $path.e -editable $editable if {$editable} { ::bind $entry [list ComboBox::_unmapliste $path] } else { ::bind $entry [list ArrowButton::invoke $path.a] if { ![string equal [Widget::cget $path -state] "disabled"] } { Entry::configure $path.e -takefocus 1 } } ::bind $path [list ComboBox::_unmapliste $path] ::bind $entry [list ComboBox::_unmapliste $path] ::bind $entry [list ComboBox::_mapliste $path] ::bind $entry [list ComboBox::_modify_value $path previous] ::bind $entry [list ComboBox::_modify_value $path next] ::bind $entry [list ComboBox::_modify_value $path first] ::bind $entry [list ComboBox::_modify_value $path last] if {$editable} { set expand [Widget::cget $path -expand] if {[string equal "tab" $expand]} { # Expand entry value on Tab (from -values) ::bind $entry "[list ComboBox::_expand $path]; break" } elseif {[string equal "auto" $expand]} { # Expand entry value anytime (from -values) #::bind $entry "[list ComboBox::_expand $path]; break" } } ## If we have images, we have to use a BWidget ListBox. set bw [Widget::cget $path -bwlistbox] if {[llength [Widget::cget $path -images]]} { Widget::configure $path [list -bwlistbox 1] } else { Widget::configure $path [list -bwlistbox $bw] } return [Widget::create ComboBox $path] } # ComboBox::configure -- # # Configure subcommand for ComboBox widgets. Works like regular # widget configure command. # # Arguments: # path Name of the ComboBox widget. # args Additional optional arguments: # ?-option? # ?-option value ...? # # Results: # Depends on arguments. If no arguments are given, returns a complete # list of configuration information. If one argument is given, returns # the configuration information for that option. If more than one # argument is given, returns nothing. proc ComboBox::configure { path args } { set res [Widget::configure $path $args] set entry $path.e set list [list -images -values -bwlistbox -hottrack] foreach {ci cv cb ch} [eval Widget::hasChangedX $path $list] { break } if { $ci } { set images [Widget::cget $path -images] if {[llength $images]} { Widget::configure $path [list -bwlistbox 1] } else { Widget::configure $path [list -bwlistbox 0] } } set bw [Widget::cget $path -bwlistbox] ## If the images, bwlistbox, hottrack or values have changed, ## destroy the shell so that it will re-create itself the next ## time around. if { $ci || $cb || $ch || ($bw && $cv) } { destroy $path.shell } set chgedit [Widget::hasChangedX $path -editable] if {$chgedit} { if {[Widget::cget $path -editable]} { ::bind $entry [list ComboBox::_unmapliste $path] Entry::configure $entry -editable true } else { ::bind $entry [list ArrowButton::invoke $path.a] Entry::configure $entry -editable false # Make sure that non-editable comboboxes can still be tabbed to. if { ![string equal [Widget::cget $path -state] "disabled"] } { Entry::configure $entry -takefocus 1 } } } if {$chgedit || [Widget::hasChangedX $path -expand]} { # Unset what we may have created. ::bind $entry {} if {[Widget::cget $path -editable]} { set expand [Widget::cget $path -expand] if {[string equal "tab" $expand]} { # Expand entry value on Tab (from -values) ::bind $entry "[list ComboBox::_expand $path]; break" } elseif {[string equal "auto" $expand]} { # Expand entry value anytime (from -values) #::bind $entry "[list ComboBox::_expand $path]; break" } } } # if the dropdown listbox is shown, simply force the actual entry # colors into it. If it is not shown, the next time the dropdown # is shown it'll get the actual colors anyway if {[winfo exists $path.shell.listb]} { $path.shell.listb configure \ -bg [Widget::cget $path -entrybg] \ -fg [Widget::cget $path -foreground] \ -selectbackground [Widget::cget $path -selectbackground] \ -selectforeground [Widget::cget $path -selectforeground] } return $res } # ---------------------------------------------------------------------------- # Command ComboBox::cget # ---------------------------------------------------------------------------- proc ComboBox::cget { path option } { return [Widget::cget $path $option] } # ---------------------------------------------------------------------------- # Command ComboBox::setvalue # ---------------------------------------------------------------------------- proc ComboBox::setvalue { path index } { set values [Widget::getMegawidgetOption $path -values] set value [Entry::cget $path.e -text] switch -- $index { next { if { [set idx [lsearch -exact $values $value]] != -1 } { incr idx } else { set idx [lsearch -exact $values "$value*"] } } previous { if { [set idx [lsearch -exact $values $value]] != -1 } { incr idx -1 } else { set idx [lsearch -exact $values "$value*"] } } first { set idx 0 } last { set idx [expr {[llength $values]-1}] } default { if { [string index $index 0] == "@" } { set idx [string range $index 1 end] if { ![string is integer -strict $idx] } { return -code error "bad index \"$index\"" } } else { return -code error "bad index \"$index\"" } } } if { $idx >= 0 && $idx < [llength $values] } { set newval [lindex $values $idx] Entry::configure $path.e -text $newval return 1 } return 0 } proc ComboBox::icursor { path idx } { return [$path.e icursor $idx] } proc ComboBox::get { path } { return [$path.e get] } # ---------------------------------------------------------------------------- # Command ComboBox::getvalue # ---------------------------------------------------------------------------- proc ComboBox::getvalue { path } { set values [Widget::getMegawidgetOption $path -values] set value [Entry::cget $path.e -text] return [lsearch -exact $values $value] } proc ComboBox::getlistbox { path } { _create_popup $path return $path.shell.listb } # ---------------------------------------------------------------------------- # Command ComboBox::post # ---------------------------------------------------------------------------- proc ComboBox::post { path } { _mapliste $path return } proc ComboBox::unpost { path } { _unmapliste $path return } # ---------------------------------------------------------------------------- # Command ComboBox::bind # ---------------------------------------------------------------------------- proc ComboBox::bind { path args } { return [eval [list ::bind $path.e] $args] } proc ComboBox::insert { path idx args } { upvar #0 [Widget::varForOption $path -values] values if {[Widget::cget $path -bwlistbox]} { set l [$path getlistbox] set i [eval $l insert $idx #auto $args] set text [$l itemcget $i -text] if {$idx == "end"} { lappend values $text } else { set values [linsert $values $idx $text] } } else { set values [eval linsert [list $values] $idx $args] } } # ---------------------------------------------------------------------------- # Command ComboBox::_create_popup # ---------------------------------------------------------------------------- proc ComboBox::_create_popup { path } { set shell $path.shell if {[winfo exists $shell]} { return } set lval [Widget::cget $path -values] set h [Widget::cget $path -height] set bw [Widget::cget $path -bwlistbox] if { $h <= 0 } { set len [llength $lval] if { $len < 3 } { set h 3 } elseif { $len > 10 } { set h 10 } else { set h $len } } if { $::tcl_platform(platform) == "unix" } { set sbwidth 11 } else { set sbwidth 15 } toplevel $shell -relief solid -bd 1 wm withdraw $shell update idletasks wm overrideredirect $shell 1 wm transient $shell [winfo toplevel $path] wm withdraw $shell catch { wm attributes $shell -topmost 1 } set sw [ScrolledWindow $shell.sw -managed 0 -size $sbwidth -ipad 0] if {$bw} { set listb [ListBox $shell.listb \ -relief flat -borderwidth 0 -highlightthickness 0 \ -selectmode single -selectfill 1 -autofocus 0 -height $h \ -font [Widget::cget $path -font] \ -bg [Widget::cget $path -entrybg] \ -fg [Widget::cget $path -foreground] \ -selectbackground [Widget::cget $path -selectbackground] \ -selectforeground [Widget::cget $path -selectforeground]] set values [Widget::cget $path -values] set images [Widget::cget $path -images] foreach value $values image $images { $listb insert end #auto -text $value -image $image } $listb bindText <1> "ComboBox::_select $path" $listb bindImage <1> "ComboBox::_select $path" if {[Widget::cget $path -hottrack]} { $listb bindText [list $listb selection set] $listb bindImage [list $listb selection set] } } else { set listb [listbox $shell.listb \ -relief flat -borderwidth 0 -highlightthickness 0 \ -exportselection false \ -font [Widget::cget $path -font] \ -height $h \ -bg [Widget::cget $path -entrybg] \ -fg [Widget::cget $path -foreground] \ -selectbackground [Widget::cget $path -selectbackground] \ -selectforeground [Widget::cget $path -selectforeground] \ -listvariable [Widget::varForOption $path -values]] ::bind $listb [list ComboBox::_select $path @%x,%y] if {[Widget::cget $path -hottrack]} { bindtags $listb [concat [bindtags $listb] ListBoxHotTrack] } } pack $sw -fill both -expand yes $sw setwidget $listb ::bind $listb "ComboBox::_select $path \[%W curselection]" ::bind $listb [list ComboBox::_unmapliste $path] ::bind $listb [list ComboBox::_focus_out $path] } proc ComboBox::_recreate_popup { path } { variable background variable foreground set shell $path.shell set lval [Widget::cget $path -values] set h [Widget::cget $path -height] set bw [Widget::cget $path -bwlistbox] if { $h <= 0 } { set len [llength $lval] if { $len < 3 } { set h 3 } elseif { $len > 10 } { set h 10 } else { set h $len } } if { $::tcl_platform(platform) == "unix" } { set sbwidth 11 } else { set sbwidth 15 } _create_popup $path if {![Widget::cget $path -editable]} { if {[info exists background]} { $path.e configure -bg $background $path.e configure -fg $foreground unset background unset foreground } } set listb $shell.listb destroy $shell.sw set sw [ScrolledWindow $shell.sw -managed 0 -size $sbwidth -ipad 0] $listb configure \ -height $h \ -font [Widget::cget $path -font] \ -bg [Widget::cget $path -entrybg] \ -fg [Widget::cget $path -foreground] \ -selectbackground [Widget::cget $path -selectbackground] \ -selectforeground [Widget::cget $path -selectforeground] pack $sw -fill both -expand yes $sw setwidget $listb raise $listb } # ---------------------------------------------------------------------------- # Command ComboBox::_mapliste # ---------------------------------------------------------------------------- proc ComboBox::_mapliste { path } { set listb $path.shell.listb if {[winfo exists $path.shell] && [string equal [wm state $path.shell] "normal"]} { _unmapliste $path return } if { [Widget::cget $path -state] == "disabled" } { return } if { [set cmd [Widget::getMegawidgetOption $path -postcommand]] != "" } { uplevel \#0 $cmd } if { ![llength [Widget::getMegawidgetOption $path -values]] } { return } _recreate_popup $path ArrowButton::configure $path.a -relief sunken update set bw [Widget::cget $path -bwlistbox] $listb selection clear 0 end set values [Widget::getMegawidgetOption $path -values] set curval [Entry::cget $path.e -text] if { [set idx [lsearch -exact $values $curval]] != -1 || [set idx [lsearch -exact $values "$curval*"]] != -1 } { if {$bw} { set idx [$listb items $idx] } else { $listb activate $idx } $listb selection set $idx $listb see $idx } else { set idx 0 if {$bw} { set idx [$listb items 0] } else { $listb activate $idx } $listb selection set $idx $listb see $idx } set width [Widget::cget $path -listboxwidth] if {!$width} { set width [winfo width $path] } BWidget::place $path.shell $width 0 below $path wm deiconify $path.shell raise $path.shell BWidget::focus set $listb BWidget::grab global $path } # ---------------------------------------------------------------------------- # Command ComboBox::_unmapliste # ---------------------------------------------------------------------------- proc ComboBox::_unmapliste { path {refocus 1} } { if {[winfo exists $path.shell] && \ [string equal [wm state $path.shell] "normal"]} { BWidget::grab release $path BWidget::focus release $path.shell.listb $refocus # Update now because otherwise [focus -force...] makes the app hang! if {$refocus} { update focus -force $path.e } wm withdraw $path.shell ArrowButton::configure $path.a -relief raised } } # ---------------------------------------------------------------------------- # Command ComboBox::_select # ---------------------------------------------------------------------------- proc ComboBox::_select { path index } { set index [$path.shell.listb index $index] _unmapliste $path if { $index != -1 } { if { [setvalue $path @$index] } { set cmd [Widget::getMegawidgetOption $path -modifycmd] if { $cmd != "" } { uplevel \#0 $cmd } } } $path.e selection clear $path.e selection range 0 end } # ---------------------------------------------------------------------------- # Command ComboBox::_modify_value # ---------------------------------------------------------------------------- proc ComboBox::_modify_value { path direction } { if { [setvalue $path $direction] } { if { [set cmd [Widget::getMegawidgetOption $path -modifycmd]] != "" } { uplevel \#0 $cmd } } } # ---------------------------------------------------------------------------- # Command ComboBox::_expand # ---------------------------------------------------------------------------- proc ComboBox::_expand {path} { set values [Widget::getMegawidgetOption $path -values] if {![llength $values]} { bell return 0 } set found {} set curval [Entry::cget $path.e -text] set curlen [$path.e index insert] if {$curlen < [string length $curval]} { # we are somewhere in the middle of a string. # if the full value matches some string in the listbox, # reorder values to start matching after that string. set idx [lsearch -exact $values $curval] if {$idx >= 0} { set values [concat [lrange $values [expr {$idx+1}] end] \ [lrange $values 0 $idx]] } } if {$curlen == 0} { set found $values } else { foreach val $values { if {[string equal -length $curlen $curval $val]} { lappend found $val } } } if {[llength $found]} { Entry::configure $path.e -text [lindex $found 0] if {[llength $found] > 1} { set best [_best_match $found [string range $curval 0 $curlen]] set blen [string length $best] $path.e icursor $blen $path.e selection range $blen end } } else { bell } return [llength $found] } # best_match -- # finds the best unique match in a list of names # The extra $e in this argument allows us to limit the innermost loop a # little further. # Arguments: # l list to find best unique match in # e currently best known unique match # Returns: # longest unique match in the list # proc ComboBox::_best_match {l {e {}}} { set ec [lindex $l 0] if {[llength $l]>1} { set e [string length $e]; incr e -1 set ei [string length $ec]; incr ei -1 foreach l $l { while {$ei>=$e && [string first $ec $l]} { set ec [string range $ec 0 [incr ei -1]] } } } return $ec } # possibly faster #proc match {string1 string2} { # set i 1 # while {[string equal -length $i $string1 $string2]} { incr i } # return [string range $string1 0 [expr {$i-2}]] #} #proc matchlist {list} { # set list [lsort $list] # return [match [lindex $list 0] [lindex $list end]] #} # ---------------------------------------------------------------------------- # Command ComboBox::_traverse_in # Called when widget receives keyboard focus due to keyboard traversal. # ---------------------------------------------------------------------------- proc ComboBox::_traverse_in { path } { if {[$path.e selection present] != 1} { # Autohighlight the selection, but not if one existed $path.e selection range 0 end } } # ---------------------------------------------------------------------------- # Command ComboBox::_focus_out # ---------------------------------------------------------------------------- proc ComboBox::_focus_out { path } { if {[focus] == ""} { # we lost focus to some other app, make sure we drop the listbox return [_unmapliste $path 0] } } proc ComboBox::_auto_complete { path key } { ## Anything that is all lowercase is either a letter, number ## or special key we're ok with. Everything else is a ## functional key of some kind. if {[string tolower $key] != $key} { return } set text [string map [list {[} {\[} {]} {\]}] [$path.e get]] if {[string equal $text ""]} { return } set values [Widget::cget $path -values] set x [lsearch $values $text*] if {$x < 0} { return } set idx [$path.e index insert] $path.e configure -text [lindex $values $x] $path.e icursor $idx $path.e select range insert end } astk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/dialog.tcl0000644004705000470430000002520312161053524021315 0ustar courtoisasterdev# ---------------------------------------------------------------------------- # dialog.tcl # This file is part of Unifix BWidget Toolkit # $Id: dialog.tcl 606 2004-04-05 07:06:06Z mcourtoi $ # ---------------------------------------------------------------------------- # Index of commands: # - Dialog::create # - Dialog::configure # - Dialog::cget # - Dialog::getframe # - Dialog::add # - Dialog::itemconfigure # - Dialog::itemcget # - Dialog::invoke # - Dialog::setfocus # - Dialog::enddialog # - Dialog::draw # - Dialog::withdraw # - Dialog::_destroy # ---------------------------------------------------------------------------- # JDC: added -transient and -place flag namespace eval Dialog { Widget::define Dialog dialog ButtonBox Widget::bwinclude Dialog ButtonBox .bbox \ remove {-orient} \ initialize {-spacing 10 -padx 10} Widget::declare Dialog { {-title String "" 0} {-geometry String "" 0} {-modal Enum local 0 {none local global}} {-bitmap TkResource "" 1 label} {-image TkResource "" 1 label} {-separator Boolean 0 1} {-cancel Int -1 0 "%d >= -1"} {-parent String "" 0} {-side Enum bottom 1 {bottom left top right}} {-anchor Enum c 1 {n e w s c}} {-class String Dialog 1} {-transient Boolean 1 1} {-place Enum center 0 {none center left right above below}} } Widget::addmap Dialog "" :cmd {-background {}} Widget::addmap Dialog "" .frame {-background {}} bind BwDialog [list Dialog::_destroy %W] variable _widget } # ---------------------------------------------------------------------------- # Command Dialog::create # ---------------------------------------------------------------------------- proc Dialog::create { path args } { global tcl_platform variable _widget array set maps [list Dialog {} .bbox {}] array set maps [Widget::parseArgs Dialog $args] # Check to see if the -class flag was specified set dialogClass "Dialog" array set dialogArgs $maps(Dialog) if { [info exists dialogArgs(-class)] } { set dialogClass $dialogArgs(-class) } if { [string equal $tcl_platform(platform) "unix"] } { set re raised set bd 1 } else { set re flat set bd 0 } toplevel $path -relief $re -borderwidth $bd -class $dialogClass Widget::initFromODB Dialog $path $maps(Dialog) bindtags $path [list $path BwDialog all] wm overrideredirect $path 1 wm title $path [Widget::cget $path -title] set parent [Widget::cget $path -parent] if { ![winfo exists $parent] } { set parent [winfo parent $path] } # JDC: made transient optional if { [Widget::getoption $path -transient] } { wm transient $path [winfo toplevel $parent] } wm withdraw $path set side [Widget::cget $path -side] if { [string equal $side "left"] || [string equal $side "right"] } { set orient vertical } else { set orient horizontal } set bbox [eval [list ButtonBox::create $path.bbox] $maps(.bbox) -orient $orient] set frame [frame $path.frame -relief flat -borderwidth 0] set bg [Widget::cget $path -background] $path configure -background $bg $frame configure -background $bg if { [set bitmap [Widget::getoption $path -image]] != "" } { set label [label $path.label -image $bitmap -background $bg] } elseif { [set bitmap [Widget::getoption $path -bitmap]] != "" } { set label [label $path.label -bitmap $bitmap -background $bg] } if { [Widget::getoption $path -separator] } { Separator::create $path.sep -orient $orient -background $bg } set _widget($path,realized) 0 set _widget($path,nbut) 0 bind $path "ButtonBox::invoke $path.bbox [Widget::getoption $path -cancel]" bind $path "ButtonBox::invoke $path.bbox default" return [Widget::create Dialog $path] } # ---------------------------------------------------------------------------- # Command Dialog::configure # ---------------------------------------------------------------------------- proc Dialog::configure { path args } { set res [Widget::configure $path $args] if { [Widget::hasChanged $path -title title] } { wm title $path $title } if { [Widget::hasChanged $path -background bg] } { if { [winfo exists $path.label] } { $path.label configure -background $bg } if { [winfo exists $path.sep] } { Separator::configure $path.sep -background $bg } } return $res } # ---------------------------------------------------------------------------- # Command Dialog::cget # ---------------------------------------------------------------------------- proc Dialog::cget { path option } { return [Widget::cget $path $option] } # ---------------------------------------------------------------------------- # Command Dialog::getframe # ---------------------------------------------------------------------------- proc Dialog::getframe { path } { return $path.frame } # ---------------------------------------------------------------------------- # Command Dialog::add # ---------------------------------------------------------------------------- proc Dialog::add { path args } { variable _widget set cmd [list ButtonBox::add $path.bbox \ -command [list Dialog::enddialog $path $_widget($path,nbut)]] set res [eval $cmd $args] incr _widget($path,nbut) return $res } # ---------------------------------------------------------------------------- # Command Dialog::itemconfigure # ---------------------------------------------------------------------------- proc Dialog::itemconfigure { path index args } { return [eval [list ButtonBox::itemconfigure $path.bbox $index] $args] } # ---------------------------------------------------------------------------- # Command Dialog::itemcget # ---------------------------------------------------------------------------- proc Dialog::itemcget { path index option } { return [ButtonBox::itemcget $path.bbox $index $option] } # ---------------------------------------------------------------------------- # Command Dialog::invoke # ---------------------------------------------------------------------------- proc Dialog::invoke { path index } { ButtonBox::invoke $path.bbox $index } # ---------------------------------------------------------------------------- # Command Dialog::setfocus # ---------------------------------------------------------------------------- proc Dialog::setfocus { path index } { ButtonBox::setfocus $path.bbox $index } # ---------------------------------------------------------------------------- # Command Dialog::enddialog # ---------------------------------------------------------------------------- proc Dialog::enddialog { path result } { variable _widget set _widget($path,result) $result } # ---------------------------------------------------------------------------- # Command Dialog::draw # ---------------------------------------------------------------------------- proc Dialog::draw { path {focus ""} {overrideredirect 0} {geometry ""}} { variable _widget set parent [Widget::getoption $path -parent] if { !$_widget($path,realized) } { set _widget($path,realized) 1 if { [llength [winfo children $path.bbox]] } { set side [Widget::getoption $path -side] if {[string equal $side "left"] || [string equal $side "right"]} { set pad -padx set fill y } else { set pad -pady set fill x } pack $path.bbox -side $side -anchor [Widget::getoption $path -anchor] -padx 1m -pady 1m if { [winfo exists $path.sep] } { pack $path.sep -side $side -fill $fill $pad 2m } } if { [winfo exists $path.label] } { pack $path.label -side left -anchor n -padx 3m -pady 3m } pack $path.frame -padx 1m -pady 1m -fill both -expand yes } set geom [Widget::getMegawidgetOption $path -geometry] if { $geom != "" } { wm geometry $path $geom } if { [string equal $geometry ""] && ($geom == "") } { set place [Widget::getoption $path -place] if { ![string equal $place none] } { if { [winfo exists $parent] } { BWidget::place $path 0 0 $place $parent } else { BWidget::place $path 0 0 $place } } } else { if { $geom != "" } { wm geometry $path $geom } else { wm geometry $path $geometry } } update idletasks wm overrideredirect $path $overrideredirect wm deiconify $path # patch by Bastien Chevreux (bach@mwgdna.com) # As seen on Windows systems *sigh* # When the toplevel is withdrawn, the tkwait command will wait forever. # So, check that we are not withdrawn if {![winfo exists $parent] || \ ([wm state [winfo toplevel $parent]] != "withdrawn")} { tkwait visibility $path } BWidget::focus set $path if { [winfo exists $focus] } { focus -force $focus } else { ButtonBox::setfocus $path.bbox default } if { [set grab [Widget::cget $path -modal]] != "none" } { BWidget::grab $grab $path if {[info exists _widget($path,result)]} { unset _widget($path,result) } tkwait variable Dialog::_widget($path,result) if { [info exists _widget($path,result)] } { set res $_widget($path,result) unset _widget($path,result) } else { set res -1 } withdraw $path return $res } return "" } # ---------------------------------------------------------------------------- # Command Dialog::withdraw # ---------------------------------------------------------------------------- proc Dialog::withdraw { path } { BWidget::grab release $path BWidget::focus release $path if { [winfo exists $path] } { wm withdraw $path } } # ---------------------------------------------------------------------------- # Command Dialog::_destroy # ---------------------------------------------------------------------------- proc Dialog::_destroy { path } { variable _widget Dialog::enddialog $path -1 BWidget::grab release $path BWidget::focus release $path if {[info exists _widget($path,result)]} { unset _widget($path,result) } unset _widget($path,realized) unset _widget($path,nbut) Widget::destroy $path } astk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/dragsite.tcl0000644004705000470430000001460012161053524021657 0ustar courtoisasterdev# ------------------------------------------------------------------------------ # dragsite.tcl # This file is part of Unifix BWidget Toolkit # $Id: dragsite.tcl 606 2004-04-05 07:06:06Z mcourtoi $ # ------------------------------------------------------------------------------ # Index of commands: # - DragSite::include # - DragSite::setdrag # - DragSite::register # - DragSite::_begin_drag # - DragSite::_init_drag # - DragSite::_end_drag # - DragSite::_update_operation # ---------------------------------------------------------------------------- namespace eval DragSite { Widget::define DragSite dragsite -classonly Widget::declare DragSite [list \ [list -dragevent Enum 1 0 [list 1 2 3]] \ [list -draginitcmd String "" 0] \ [list -dragendcmd String "" 0] \ ] variable _topw ".drag" variable _tabops variable _state variable _x0 variable _y0 bind BwDrag1 {DragSite::_begin_drag press %W %s %X %Y} bind BwDrag1 {DragSite::_begin_drag motion %W %s %X %Y} bind BwDrag2 {DragSite::_begin_drag press %W %s %X %Y} bind BwDrag2 {DragSite::_begin_drag motion %W %s %X %Y} bind BwDrag3 {DragSite::_begin_drag press %W %s %X %Y} bind BwDrag3 {DragSite::_begin_drag motion %W %s %X %Y} proc use {} {} } # ---------------------------------------------------------------------------- # Command DragSite::include # ---------------------------------------------------------------------------- proc DragSite::include { class type event } { set dragoptions [list \ [list -dragenabled Boolean 0 0] \ [list -draginitcmd String "" 0] \ [list -dragendcmd String "" 0] \ [list -dragtype String $type 0] \ [list -dragevent Enum $event 0 [list 1 2 3]] \ ] Widget::declare $class $dragoptions } # ---------------------------------------------------------------------------- # Command DragSite::setdrag # Widget interface to register # ---------------------------------------------------------------------------- proc DragSite::setdrag { path subpath initcmd endcmd {force 0}} { set cen [Widget::hasChanged $path -dragenabled en] set cdragevt [Widget::hasChanged $path -dragevent dragevt] if { $en } { if { $force || $cen || $cdragevt } { register $subpath \ -draginitcmd $initcmd \ -dragendcmd $endcmd \ -dragevent $dragevt } } else { register $subpath } } # ---------------------------------------------------------------------------- # Command DragSite::register # ---------------------------------------------------------------------------- proc DragSite::register { path args } { upvar \#0 DragSite::$path drag if { [info exists drag] } { bind $path $drag(evt) {} unset drag } Widget::init DragSite .drag$path $args set event [Widget::getMegawidgetOption .drag$path -dragevent] set initcmd [Widget::getMegawidgetOption .drag$path -draginitcmd] set endcmd [Widget::getMegawidgetOption .drag$path -dragendcmd] set tags [bindtags $path] set idx [lsearch $tags "BwDrag*"] Widget::destroy .drag$path if { $initcmd != "" } { if { $idx != -1 } { bindtags $path [lreplace $tags $idx $idx BwDrag$event] } else { bindtags $path [concat $tags BwDrag$event] } set drag(initcmd) $initcmd set drag(endcmd) $endcmd set drag(evt) $event } elseif { $idx != -1 } { bindtags $path [lreplace $tags $idx $idx] } } # ---------------------------------------------------------------------------- # Command DragSite::_begin_drag # ---------------------------------------------------------------------------- proc DragSite::_begin_drag { event source state X Y } { variable _x0 variable _y0 variable _state switch -- $event { press { set _x0 $X set _y0 $Y set _state "press" } motion { if { ![info exists _state] } { # This is just extra protection. There seem to be # rare cases where the motion comes before the press. return } if { [string equal $_state "press"] } { if { abs($_x0-$X) > 3 || abs($_y0-$Y) > 3 } { set _state "done" _init_drag $source $state $X $Y } } } } } # ---------------------------------------------------------------------------- # Command DragSite::_init_drag # ---------------------------------------------------------------------------- proc DragSite::_init_drag { source state X Y } { variable _topw upvar \#0 DragSite::$source drag destroy $_topw toplevel $_topw wm withdraw $_topw wm overrideredirect $_topw 1 set info [uplevel \#0 $drag(initcmd) [list $source $X $Y .drag]] if { $info != "" } { set type [lindex $info 0] set ops [lindex $info 1] set data [lindex $info 2] if { [winfo children $_topw] == "" } { if { [string equal $type "BITMAP"] || [string equal $type "IMAGE"] } { label $_topw.l -image [Bitmap::get dragicon] -relief flat -bd 0 } else { label $_topw.l -image [Bitmap::get dragfile] -relief flat -bd 0 } pack $_topw.l } wm geometry $_topw +[expr {$X+1}]+[expr {$Y+1}] wm deiconify $_topw if {[catch {tkwait visibility $_topw}]} { return } BWidget::grab set $_topw BWidget::focus set $_topw bindtags $_topw [list $_topw DragTop] DropSite::_init_drag $_topw $drag(evt) $source $state $X $Y $type $ops $data } else { destroy $_topw } } # ---------------------------------------------------------------------------- # Command DragSite::_end_drag # ---------------------------------------------------------------------------- proc DragSite::_end_drag { source target op type data result } { variable _topw upvar \#0 DragSite::$source drag BWidget::grab release $_topw BWidget::focus release $_topw destroy $_topw if { $drag(endcmd) != "" } { uplevel \#0 $drag(endcmd) [list $source $target $op $type $data $result] } } astk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/dropsite.tcl0000644004705000470430000003662012161053524021714 0ustar courtoisasterdev# ------------------------------------------------------------------------------ # dropsite.tcl # This file is part of Unifix BWidget Toolkit # $Id: dropsite.tcl 606 2004-04-05 07:06:06Z mcourtoi $ # ------------------------------------------------------------------------------ # Index of commands: # - DropSite::include # - DropSite::setdrop # - DropSite::register # - DropSite::setcursor # - DropSite::setoperation # - DropSite::_update_operation # - DropSite::_compute_operation # - DropSite::_draw_operation # - DropSite::_init_drag # - DropSite::_motion # - DropSite::_release # ---------------------------------------------------------------------------- namespace eval DropSite { Widget::define DropSite dropsite -classonly Widget::declare DropSite [list \ [list -dropovercmd String "" 0] \ [list -dropcmd String "" 0] \ [list -droptypes String "" 0] \ ] proc use {} {} variable _top ".drag" variable _opw ".drag.\#op" variable _target "" variable _status 0 variable _tabops variable _defops variable _source variable _type variable _data variable _evt # key win unix # shift 1 | 1 -> 1 # control 4 | 4 -> 4 # alt 8 | 16 -> 24 # meta | 64 -> 88 array set _tabops { mod,none 0 mod,shift 1 mod,control 4 mod,alt 24 ops,copy 1 ops,move 1 ops,link 1 } if { $tcl_platform(platform) == "unix" } { set _tabops(mod,alt) 8 } else { set _tabops(mod,alt) 16 } array set _defops \ [list \ copy,mod shift \ move,mod control \ link,mod alt \ copy,img @[file join $::BWIDGET::LIBRARY "images" "opcopy.xbm"] \ move,img @[file join $::BWIDGET::LIBRARY "images" "opmove.xbm"] \ link,img @[file join $::BWIDGET::LIBRARY "images" "oplink.xbm"]] bind DragTop {DropSite::_update_operation [expr %s | 1]} bind DragTop {DropSite::_update_operation [expr %s | 1]} bind DragTop {DropSite::_update_operation [expr %s | 4]} bind DragTop {DropSite::_update_operation [expr %s | 4]} if { $tcl_platform(platform) == "unix" } { bind DragTop {DropSite::_update_operation [expr %s | 8]} bind DragTop {DropSite::_update_operation [expr %s | 8]} } else { bind DragTop {DropSite::_update_operation [expr %s | 16]} bind DragTop {DropSite::_update_operation [expr %s | 16]} } bind DragTop {DropSite::_update_operation [expr %s & ~1]} bind DragTop {DropSite::_update_operation [expr %s & ~1]} bind DragTop {DropSite::_update_operation [expr %s & ~4]} bind DragTop {DropSite::_update_operation [expr %s & ~4]} if { $tcl_platform(platform) == "unix" } { bind DragTop {DropSite::_update_operation [expr %s & ~8]} bind DragTop {DropSite::_update_operation [expr %s & ~8]} } else { bind DragTop {DropSite::_update_operation [expr %s & ~16]} bind DragTop {DropSite::_update_operation [expr %s & ~16]} } } # ---------------------------------------------------------------------------- # Command DropSite::include # ---------------------------------------------------------------------------- proc DropSite::include { class types } { set dropoptions [list \ [list -dropenabled Boolean 0 0] \ [list -dropovercmd String "" 0] \ [list -dropcmd String "" 0] \ [list -droptypes String $types 0] \ ] Widget::declare $class $dropoptions } # ---------------------------------------------------------------------------- # Command DropSite::setdrop # Widget interface to register # ---------------------------------------------------------------------------- proc DropSite::setdrop { path subpath dropover drop {force 0}} { set cen [Widget::hasChanged $path -dropenabled en] set ctypes [Widget::hasChanged $path -droptypes types] if { $en } { if { $force || $cen || $ctypes } { register $subpath \ -droptypes $types \ -dropcmd $drop \ -dropovercmd $dropover } } else { register $subpath } } # ---------------------------------------------------------------------------- # Command DropSite::register # ---------------------------------------------------------------------------- proc DropSite::register { path args } { variable _tabops variable _defops upvar \#0 DropSite::$path drop Widget::init DropSite .drop$path $args if { [info exists drop] } { unset drop } set dropcmd [Widget::getMegawidgetOption .drop$path -dropcmd] set types [Widget::getMegawidgetOption .drop$path -droptypes] set overcmd [Widget::getMegawidgetOption .drop$path -dropovercmd] Widget::destroy .drop$path if { $dropcmd != "" && $types != "" } { set drop(dropcmd) $dropcmd set drop(overcmd) $overcmd foreach {type ops} $types { set drop($type,ops) {} foreach {descop lmod} $ops { if { ![llength $descop] || [llength $descop] > 3 } { return -code error "invalid operation description \"$descop\"" } foreach {subop baseop imgop} $descop { set subop [string trim $subop] if { ![string length $subop] } { return -code error "sub operation is empty" } if { ![string length $baseop] } { set baseop $subop } if { [info exists drop($type,ops,$subop)] } { return -code error "operation \"$subop\" already defined" } if { ![info exists _tabops(ops,$baseop)] } { return -code error "invalid base operation \"$baseop\"" } if { ![string equal $subop $baseop] && [info exists _tabops(ops,$subop)] } { return -code error "sub operation \"$subop\" is a base operation" } if { ![string length $imgop] } { set imgop $_defops($baseop,img) } } if { [string equal $lmod "program"] } { set drop($type,ops,$subop) $baseop set drop($type,img,$subop) $imgop } else { if { ![string length $lmod] } { set lmod $_defops($baseop,mod) } set mask 0 foreach mod $lmod { if { ![info exists _tabops(mod,$mod)] } { return -code error "invalid modifier \"$mod\"" } set mask [expr {$mask | $_tabops(mod,$mod)}] } if { ($mask == 0) != ([string equal $subop "default"]) } { return -code error "sub operation default can only be used with modifier \"none\"" } set drop($type,mod,$mask) $subop set drop($type,ops,$subop) $baseop set drop($type,img,$subop) $imgop lappend masklist $mask } } if { ![info exists drop($type,mod,0)] } { set drop($type,mod,0) default set drop($type,ops,default) copy set drop($type,img,default) $_defops(copy,img) lappend masklist 0 } set drop($type,ops,force) copy set drop($type,img,force) $_defops(copy,img) foreach mask [lsort -integer -decreasing $masklist] { lappend drop($type,ops) $mask $drop($type,mod,$mask) } } } } # ---------------------------------------------------------------------------- # Command DropSite::setcursor # ---------------------------------------------------------------------------- proc DropSite::setcursor { cursor } { catch {.drag configure -cursor $cursor} } # ---------------------------------------------------------------------------- # Command DropSite::setoperation # ---------------------------------------------------------------------------- proc DropSite::setoperation { op } { variable _curop variable _dragops variable _target variable _type upvar \#0 DropSite::$_target drop if { [info exist drop($_type,ops,$op)] && $_dragops($drop($_type,ops,$op)) } { set _curop $op } else { # force to a copy operation set _curop force } } # ---------------------------------------------------------------------------- # Command DropSite::_init_drag # ---------------------------------------------------------------------------- proc DropSite::_init_drag { top evt source state X Y type ops data } { variable _top variable _source variable _type variable _data variable _target variable _status variable _state variable _dragops variable _opw variable _evt if {[info exists _dragops]} { unset _dragops } array set _dragops {copy 1 move 0 link 0} foreach op $ops { set _dragops($op) 1 } set _target "" set _status 0 set _top $top set _source $source set _type $type set _data $data label $_opw -relief flat -bd 0 -highlightthickness 0 \ -foreground black -background white bind $top {DropSite::_release %X %Y} bind $top {DropSite::_motion %X %Y} bind $top {DropSite::_release %X %Y} set _state $state set _evt $evt _motion $X $Y } # ---------------------------------------------------------------------------- # Command DropSite::_update_operation # ---------------------------------------------------------------------------- proc DropSite::_update_operation { state } { variable _top variable _status variable _state if { $_status & 3 } { set _state $state _motion [winfo pointerx $_top] [winfo pointery $_top] } } # ---------------------------------------------------------------------------- # Command DropSite::_compute_operation # ---------------------------------------------------------------------------- proc DropSite::_compute_operation { target state type } { variable _curop variable _dragops upvar \#0 DropSite::$target drop foreach {mask op} $drop($type,ops) { if { ($state & $mask) == $mask } { if { $_dragops($drop($type,ops,$op)) } { set _curop $op return } } } set _curop force } # ---------------------------------------------------------------------------- # Command DropSite::_draw_operation # ---------------------------------------------------------------------------- proc DropSite::_draw_operation { target type } { variable _opw variable _curop variable _dragops variable _tabops variable _status upvar \#0 DropSite::$target drop if { !($_status & 1) } { catch {place forget $_opw} return } if { 0 } { if { ![info exist drop($type,ops,$_curop)] || !$_dragops($drop($type,ops,$_curop)) } { # force to a copy operation set _curop copy catch { $_opw configure -bitmap $_tabops(img,copy) place $_opw -relx 1 -rely 1 -anchor se } } } elseif { [string equal $_curop "default"] } { catch {place forget $_opw} } else { catch { $_opw configure -bitmap $drop($type,img,$_curop) place $_opw -relx 1 -rely 1 -anchor se } } } # ---------------------------------------------------------------------------- # Command DropSite::_motion # ---------------------------------------------------------------------------- proc DropSite::_motion { X Y } { variable _top variable _target variable _status variable _state variable _curop variable _type variable _data variable _source variable _evt set script [bind $_top ] bind $_top {} bind $_top {} wm geometry $_top "+[expr {$X+1}]+[expr {$Y+1}]" update if { ![winfo exists $_top] } { return } set path [winfo containing $X $Y] if { ![string equal $path $_target] } { # path != current target if { $_status & 2 } { # current target is valid and has recall status # generate leave event upvar \#0 DropSite::$_target drop uplevel \#0 $drop(overcmd) [list $_target $_source leave $X $Y $_curop $_type $_data] } set _target $path upvar \#0 DropSite::$_target drop if { [info exists drop($_type,ops)] } { # path is a valid target _compute_operation $_target $_state $_type if { $drop(overcmd) != "" } { set arg [list $_target $_source enter $X $Y $_curop $_type $_data] set _status [uplevel \#0 $drop(overcmd) $arg] } else { set _status 1 catch {$_top configure -cursor based_arrow_down} } _draw_operation $_target $_type update catch { bind $_top {DropSite::_motion %X %Y} bind $_top {DropSite::_release %X %Y} } return } else { set _status 0 catch {$_top configure -cursor dot} _draw_operation "" "" } } elseif { $_status & 2 } { upvar \#0 DropSite::$_target drop _compute_operation $_target $_state $_type set arg [list $_target $_source motion $X $Y $_curop $_type $_data] set _status [uplevel \#0 $drop(overcmd) $arg] _draw_operation $_target $_type } update catch { bind $_top {DropSite::_motion %X %Y} bind $_top {DropSite::_release %X %Y} } } # ---------------------------------------------------------------------------- # Command DropSite::_release # ---------------------------------------------------------------------------- proc DropSite::_release { X Y } { variable _target variable _status variable _curop variable _source variable _type variable _data if { $_status & 1 } { upvar \#0 DropSite::$_target drop set res [uplevel \#0 $drop(dropcmd) [list $_target $_source $X $Y $_curop $_type $_data]] DragSite::_end_drag $_source $_target $drop($_type,ops,$_curop) $_type $_data $res } else { if { $_status & 2 } { # notify leave event upvar \#0 DropSite::$_target drop uplevel \#0 $drop(overcmd) [list $_target $_source leave $X $Y $_curop $_type $_data] } DragSite::_end_drag $_source "" "" $_type $_data 0 } } astk-1.13.1/ASTK_CLIENT/lib/BWidget-1.7.0/dynhelp.tcl0000644004705000470430000004464412161053524021533 0ustar courtoisasterdev# ---------------------------------------------------------------------------- # dynhelp.tcl # This file is part of Unifix BWidget Toolkit # $Id: dynhelp.tcl 606 2004-04-05 07:06:06Z mcourtoi $ # ---------------------------------------------------------------------------- # Index of commands: # - DynamicHelp::configure # - DynamicHelp::include # - DynamicHelp::sethelp # - DynamicHelp::register # - DynamicHelp::_motion_balloon # - DynamicHelp::_motion_info # - DynamicHelp::_leave_info # - DynamicHelp::_menu_info # - DynamicHelp::_show_help # - DynamicHelp::_init # ---------------------------------------------------------------------------- # JDC: allow variable and ballon help at the same timees namespace eval DynamicHelp { Widget::define DynamicHelp dynhelp -classonly Widget::declare DynamicHelp { {-foreground TkResource black 0 label} {-topbackground TkResource black 0 {label -foreground}} {-background TkResource "#FFFFC0" 0 label} {-borderwidth TkResource 1 0 label} {-justify TkResource left 0 label} {-font TkResource "helvetica 8" 0 label} {-delay Int 600 0 "%d >= 100 & %d <= 2000"} {-state Enum "normal" 0 {normal disabled}} {-padx TkResource 1 0 label} {-pady TkResource 1 0 label} {-bd Synonym -borderwidth} {-bg Synonym -background} {-fg Synonym -foreground} {-topbg Synonym -topbackground} } proc use {} {} variable _registered variable _canvases variable _top ".help_shell" variable _id "" variable _delay 600 variable _current_balloon "" variable _current_variable "" variable _saved Widget::init DynamicHelp $_top {} bind BwHelpBalloon {DynamicHelp::_motion_balloon enter %W %X %Y} bind BwHelpBalloon {DynamicHelp::_motion_balloon motion %W %X %Y} bind BwHelpBalloon {DynamicHelp::_motion_balloon leave %W %X %Y} bind BwHelpBalloon