gtcltk and bwidget removal reverted - to make nviz working again

git-svn-id: https://svn.osgeo.org/grass/grass/trunk@35358 15284696-431f-4ddb-bdfa-cd5b030d7da7

lib/Makefile

@@ -20,6 +20,7 @@ SUBDIRS = \
 	db \
 	external \
 	fonts \
+	gtcltk \
 	form \
 	imagery \
 	cluster \

lib/external/Makefile

@@ -1,6 +1,9 @@
+
 MODULE_TOPDIR = ../..
 
-SUBDIRS = shapelib
+SUBDIRS = \
+	bwidget \
+	shapelib
 
 include $(MODULE_TOPDIR)/include/Make/Dir.make
 

lib/external/bwidget/CHANGES.txt

@@ -0,0 +1,266 @@
+____________________________________________________________
+BWidget 1.2.1 (07/09/1999)
+
+CHANGES FROM 1.2 TO 1.2.1
+
+  This version is the first patch of 1.2. It does not introduce
+  incompatibilites.
+  This patch include some new requested features, that I think
+  can't wait for 1.3:
+     - special menu handling (see MainFrame)
+     - tabs bindings in NoteBook
+     - label alignment of LabelFrame
+     - -repeatdelay and -repeatinterval options on SpinBox
+
+
+* Entry
+    - <Destroy> 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 <ButtonPress-x> followed by <Bx-Motion> of
+      4 pixels, so it is possible to have a <ButtonPress-x> 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.
+

lib/external/bwidget/LGPL.txt

@@ -0,0 +1,481 @@
+		  GNU LIBRARY GENERAL PUBLIC LICENSE
+		       Version 2, June 1991
+
+ Copyright (C) 1991 Free Software Foundation, Inc.
+    		    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+[This is the first released version of the library GPL.  It is
+ numbered 2 because it goes with version 2 of the ordinary GPL.]
+
+			    Preamble
+
+  The licenses for most software are designed to take away your
+freedom to share and change it.  By contrast, the GNU General Public
+Licenses are intended to guarantee your freedom to share and change
+free software--to make sure the software is free for all its users.
+
+  This license, the Library General Public License, applies to some
+specially designated Free Software Foundation software, and to any
+other libraries whose authors decide to use it.  You can use it for
+your libraries, too.
+
+  When we speak of free software, we are referring to freedom, not
+price.  Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+this service if you wish), that you receive source code or can get it
+if you want it, that you can change the software or use pieces of it
+in new free programs; and that you know you can do these things.
+
+  To protect your rights, we need to make restrictions that forbid
+anyone to deny you these rights or to ask you to surrender the rights.
+These restrictions translate to certain responsibilities for you if
+you distribute copies of the library, or if you modify it.
+
+  For example, if you distribute copies of the library, whether gratis
+or for a fee, you must give the recipients all the rights that we gave
+you.  You must make sure that they, too, receive or can get the source
+code.  If you link a program with the library, you must provide
+complete object files to the recipients so that they can relink them
+with the library, after making changes to the library and recompiling
+it.  And you must show them these terms so they know their rights.
+
+  Our method of protecting your rights has two steps: (1) copyright
+the library, and (2) offer you this license which gives you legal
+permission to copy, distribute and/or modify the library.
+
+  Also, for each distributor's protection, we want to make certain
+that everyone understands that there is no warranty for this free
+library.  If the library is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original
+version, so that any problems introduced by others will not reflect on
+the original authors' reputations.
+
+  Finally, any free program is threatened constantly by software
+patents.  We wish to avoid the danger that companies distributing free
+software will individually obtain patent licenses, thus in effect
+transforming the program into proprietary software.  To prevent this,
+we have made it clear that any patent must be licensed for everyone's
+free use or not licensed at all.
+
+  Most GNU software, including some libraries, is covered by the ordinary
+GNU General Public License, which was designed for utility programs.  This
+license, the GNU Library General Public License, applies to certain
+designated libraries.  This license is quite different from the ordinary
+one; be sure to read it in full, and don't assume that anything in it is
+the same as in the ordinary license.
+
+  The reason we have a separate public license for some libraries is that
+they blur the distinction we usually make between modifying or adding to a
+program and simply using it.  Linking a program with a library, without
+changing the library, is in some sense simply using the library, and is
+analogous to running a utility program or application program.  However, in
+a textual and legal sense, the linked executable is a combined work, a
+derivative of the original library, and the ordinary General Public License
+treats it as such.
+
+  Because of this blurred distinction, using the ordinary General
+Public License for libraries did not effectively promote software
+sharing, because most developers did not use the libraries.  We
+concluded that weaker conditions might promote sharing better.
+
+  However, unrestricted linking of non-free programs would deprive the
+users of those programs of all benefit from the free status of the
+libraries themselves.  This Library General Public License is intended to
+permit developers of non-free programs to use free libraries, while
+preserving your freedom as a user of such programs to change the free
+libraries that are incorporated in them.  (We have not seen how to achieve
+this as regards changes in header files, but we have achieved it as regards
+changes in the actual functions of the Library.)  The hope is that this
+will lead to faster development of free libraries.
+
+  The precise terms and conditions for copying, distribution and
+modification follow.  Pay close attention to the difference between a
+"work based on the library" and a "work that uses the library".  The
+former contains code derived from the library, while the latter only
+works together with the library.
+
+  Note that it is possible for a library to be covered by the ordinary
+General Public License rather than by this special one.
+
+		  GNU LIBRARY GENERAL PUBLIC LICENSE
+   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+  0. This License Agreement applies to any software library which
+contains a notice placed by the copyright holder or other authorized
+party saying it may be distributed under the terms of this Library
+General Public License (also called "this License").  Each licensee is
+addressed as "you".
+
+  A "library" means a collection of software functions and/or data
+prepared so as to be conveniently linked with application programs
+(which use some of those functions and data) to form executables.
+
+  The "Library", below, refers to any such software library or work
+which has been distributed under these terms.  A "work based on the
+Library" means either the Library or any derivative work under
+copyright law: that is to say, a work containing the Library or a
+portion of it, either verbatim or with modifications and/or translated
+straightforwardly into another language.  (Hereinafter, translation is
+included without limitation in the term "modification".)
+
+  "Source code" for a work means the preferred form of the work for
+making modifications to it.  For a library, complete source code means
+all the source code for all modules it contains, plus any associated
+interface definition files, plus the scripts used to control compilation
+and installation of the library.
+
+  Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope.  The act of
+running a program using the Library is not restricted, and output from
+such a program is covered only if its contents constitute a work based
+on the Library (independent of the use of the Library in a tool for
+writing it).  Whether that is true depends on what the Library does
+and what the program that uses the Library does.
+  
+  1. You may copy and distribute verbatim copies of the Library's
+complete source code as you receive it, in any medium, provided that
+you conspicuously and appropriately publish on each copy an
+appropriate copyright notice and disclaimer of warranty; keep intact
+all the notices that refer to this License and to the absence of any
+warranty; and distribute a copy of this License along with the
+Library.
+
+  You may charge a fee for the physical act of transferring a copy,
+and you may at your option offer warranty protection in exchange for a
+fee.
+
+  2. You may modify your copy or copies of the Library or any portion
+of it, thus forming a work based on the Library, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+    a) The modified work must itself be a software library.
+
+    b) You must cause the files modified to carry prominent notices
+    stating that you changed the files and the date of any change.
+
+    c) You must cause the whole of the work to be licensed at no
+    charge to all third parties under the terms of this License.
+
+    d) If a facility in the modified Library refers to a function or a
+    table of data to be supplied by an application program that uses
+    the facility, other than as an argument passed when the facility
+    is invoked, then you must make a good faith effort to ensure that,
+    in the event an application does not supply such function or
+    table, the facility still operates, and performs whatever part of
+    its purpose remains meaningful.
+
+    (For example, a function in a library to compute square roots has
+    a purpose that is entirely well-defined independent of the
+    application.  Therefore, Subsection 2d requires that any
+    application-supplied function or table used by this function must
+    be optional: if the application does not supply it, the square
+    root function must still compute square roots.)
+
+These requirements apply to the modified work as a whole.  If
+identifiable sections of that work are not derived from the Library,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works.  But when you
+distribute the same sections as part of a whole which is a work based
+on the Library, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote
+it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Library.
+
+In addition, mere aggregation of another work not based on the Library
+with the Library (or with a work based on the Library) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+  3. You may opt to apply the terms of the ordinary GNU General Public
+License instead of this License to a given copy of the Library.  To do
+this, you must alter all the notices that refer to this License, so
+that they refer to the ordinary GNU General Public License, version 2,
+instead of to this License.  (If a newer version than version 2 of the
+ordinary GNU General Public License has appeared, then you can specify
+that version instead if you wish.)  Do not make any other change in
+these notices.
+
+  Once this change is made in a given copy, it is irreversible for
+that copy, so the ordinary GNU General Public License applies to all
+subsequent copies and derivative works made from that copy.
+
+  This option is useful when you wish to copy part of the code of
+the Library into a program that is not a library.
+
+  4. You may copy and distribute the Library (or a portion or
+derivative of it, under Section 2) in object code or executable form
+under the terms of Sections 1 and 2 above provided that you accompany
+it with the complete corresponding machine-readable source code, which
+must be distributed under the terms of Sections 1 and 2 above on a
+medium customarily used for software interchange.
+
+  If distribution of object code is made by offering access to copy
+from a designated place, then offering equivalent access to copy the
+source code from the same place satisfies the requirement to
+distribute the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+  5. A program that contains no derivative of any portion of the
+Library, but is designed to work with the Library by being compiled or
+linked with it, is called a "work that uses the Library".  Such a
+work, in isolation, is not a derivative work of the Library, and
+therefore falls outside the scope of this License.
+
+  However, linking a "work that uses the Library" with the Library
+creates an executable that is a derivative of the Library (because it
+contains portions of the Library), rather than a "work that uses the
+library".  The executable is therefore covered by this License.
+Section 6 states terms for distribution of such executables.
+
+  When a "work that uses the Library" uses material from a header file
+that is part of the Library, the object code for the work may be a
+derivative work of the Library even though the source code is not.
+Whether this is true is especially significant if the work can be
+linked without the Library, or if the work is itself a library.  The
+threshold for this to be true is not precisely defined by law.
+
+  If such an object file uses only numerical parameters, data
+structure layouts and accessors, and small macros and small inline
+functions (ten lines or less in length), then the use of the object
+file is unrestricted, regardless of whether it is legally a derivative
+work.  (Executables containing this object code plus portions of the
+Library will still fall under Section 6.)
+
+  Otherwise, if the work is a derivative of the Library, you may
+distribute the object code for the work under the terms of Section 6.
+Any executables containing that work also fall under Section 6,
+whether or not they are linked directly with the Library itself.
+
+  6. As an exception to the Sections above, you may also compile or
+link a "work that uses the Library" with the Library to produce a
+work containing portions of the Library, and distribute that work
+under terms of your choice, provided that the terms permit
+modification of the work for the customer's own use and reverse
+engineering for debugging such modifications.
+
+  You must give prominent notice with each copy of the work that the
+Library is used in it and that the Library and its use are covered by
+this License.  You must supply a copy of this License.  If the work
+during execution displays copyright notices, you must include the
+copyright notice for the Library among them, as well as a reference
+directing the user to the copy of this License.  Also, you must do one
+of these things:
+
+    a) Accompany the work with the complete corresponding
+    machine-readable source code for the Library including whatever
+    changes were used in the work (which must be distributed under
+    Sections 1 and 2 above); and, if the work is an executable linked
+    with the Library, with the complete machine-readable "work that
+    uses the Library", as object code and/or source code, so that the
+    user can modify the Library and then relink to produce a modified
+    executable containing the modified Library.  (It is understood
+    that the user who changes the contents of definitions files in the
+    Library will not necessarily be able to recompile the application
+    to use the modified definitions.)
+
+    b) Accompany the work with a written offer, valid for at
+    least three years, to give the same user the materials
+    specified in Subsection 6a, above, for a charge no more
+    than the cost of performing this distribution.
+
+    c) If distribution of the work is made by offering access to copy
+    from a designated place, offer equivalent access to copy the above
+    specified materials from the same place.
+
+    d) Verify that the user has already received a copy of these
+    materials or that you have already sent this user a copy.
+
+  For an executable, the required form of the "work that uses the
+Library" must include any data and utility programs needed for
+reproducing the executable from it.  However, as a special exception,
+the source code distributed need not include anything that is normally
+distributed (in either source or binary form) with the major
+components (compiler, kernel, and so on) of the operating system on
+which the executable runs, unless that component itself accompanies
+the executable.
+
+  It may happen that this requirement contradicts the license
+restrictions of other proprietary libraries that do not normally
+accompany the operating system.  Such a contradiction means you cannot
+use both them and the Library together in an executable that you
+distribute.
+
+  7. You may place library facilities that are a work based on the
+Library side-by-side in a single library together with other library
+facilities not covered by this License, and distribute such a combined
+library, provided that the separate distribution of the work based on
+the Library and of the other library facilities is otherwise
+permitted, and provided that you do these two things:
+
+    a) Accompany the combined library with a copy of the same work
+    based on the Library, uncombined with any other library
+    facilities.  This must be distributed under the terms of the
+    Sections above.
+
+    b) Give prominent notice with the combined library of the fact
+    that part of it is a work based on the Library, and explaining
+    where to find the accompanying uncombined form of the same work.
+
+  8. You may not copy, modify, sublicense, link with, or distribute
+the Library except as expressly provided under this License.  Any
+attempt otherwise to copy, modify, sublicense, link with, or
+distribute the Library is void, and will automatically terminate your
+rights under this License.  However, parties who have received copies,
+or rights, from you under this License will not have their licenses
+terminated so long as such parties remain in full compliance.
+
+  9. You are not required to accept this License, since you have not
+signed it.  However, nothing else grants you permission to modify or
+distribute the Library or its derivative works.  These actions are
+prohibited by law if you do not accept this License.  Therefore, by
+modifying or distributing the Library (or any work based on the
+Library), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Library or works based on it.
+
+  10. Each time you redistribute the Library (or any work based on the
+Library), the recipient automatically receives a license from the
+original licensor to copy, distribute, link with or modify the Library
+subject to these terms and conditions.  You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties to
+this License.
+
+  11. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License.  If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Library at all.  For example, if a patent
+license would not permit royalty-free redistribution of the Library by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Library.
+
+If any portion of this section is held invalid or unenforceable under any
+particular circumstance, the balance of the section is intended to apply,
+and the section as a whole is intended to apply in other circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system which is
+implemented by public license practices.  Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+
+  12. If the distribution and/or use of the Library is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Library under this License may add
+an explicit geographical distribution limitation excluding those countries,
+so that distribution is permitted only in or among countries not thus
+excluded.  In such case, this License incorporates the limitation as if
+written in the body of this License.
+
+  13. The Free Software Foundation may publish revised and/or new
+versions of the Library General Public License from time to time.
+Such new versions will be similar in spirit to the present version,
+but may differ in detail to address new problems or concerns.
+
+Each version is given a distinguishing version number.  If the Library
+specifies a version number of this License which applies to it and
+"any later version", you have the option of following the terms and
+conditions either of that version or of any later version published by
+the Free Software Foundation.  If the Library does not specify a
+license version number, you may choose any version ever published by
+the Free Software Foundation.
+
+  14. If you wish to incorporate parts of the Library into other free
+programs whose distribution conditions are incompatible with these,
+write to the author to ask for permission.  For software which is
+copyrighted by the Free Software Foundation, write to the Free
+Software Foundation; we sometimes make exceptions for this.  Our
+decision will be guided by the two goals of preserving the free status
+of all derivatives of our free software and of promoting the sharing
+and reuse of software generally.
+
+			    NO WARRANTY
+
+  15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO
+WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW.
+EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR
+OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY
+KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
+LIBRARY IS WITH YOU.  SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME
+THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+  16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN
+WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY
+AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU
+FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR
+CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE
+LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
+RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
+FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
+SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
+DAMAGES.
+
+		     END OF TERMS AND CONDITIONS
+
+           How to Apply These Terms to Your New Libraries
+
+  If you develop a new library, and you want it to be of the greatest
+possible use to the public, we recommend making it free software that
+everyone can redistribute and change.  You can do so by permitting
+redistribution under these terms (or, alternatively, under the terms of the
+ordinary General Public License).
+
+  To apply these terms, attach the following notices to the library.  It is
+safest to attach them to the start of each source file to most effectively
+convey the exclusion of warranty; and each file should have at least the
+"copyright" line and a pointer to where the full notice is found.
+
+    <one line to give the library's name and a brief idea of what it does.>
+    Copyright (C) <year>  <name of author>
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Library General Public License for more details.
+
+    You should have received a copy of the GNU Library General Public
+    License along with this library; if not, write to the Free
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+Also add information on how to contact you by electronic and paper mail.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the library, if
+necessary.  Here is a sample; alter the names:
+
+  Yoyodyne, Inc., hereby disclaims all copyright interest in the
+  library `Frob' (a library for tweaking knobs) written by James Random Hacker.
+
+  <signature of Ty Coon>, 1 April 1990
+  Ty Coon, President of Vice
+
+That's all there is to it!

lib/external/bwidget/LICENSE.txt

@@ -0,0 +1,17 @@
+BWidget ToolKit
+Copyright (c) 1998-1999 UNIFIX. 
+ 
+This library is free software; you can redistribute it and/or
+modify it under the terms of the GNU Library General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+ 
+This library is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+Library General Public License for more details.
+ 
+You should have received a copy of the GNU Library General Public
+License along with this library; if not, write to the
+Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA  02111-1307, USA.

lib/external/bwidget/Makefile

@@ -0,0 +1,17 @@
+MODULE_TOPDIR = ../../..
+
+include $(MODULE_TOPDIR)/include/Make/Other.make
+
+BWIDGETDIR = $(ARCH_DISTDIR)/bwidget
+
+SRCFILES := $(wildcard images/*.* lang/*.* *.tcl *.txt) README.grass
+DSTFILES := $(patsubst %,$(BWIDGETDIR)/%,$(SRCFILES))
+
+default:
+	if [ ! -d $(BWIDGETDIR) ]; then $(MKDIR) $(BWIDGETDIR); fi
+	if [ ! -d $(BWIDGETDIR)/images ]; then $(MKDIR) $(BWIDGETDIR)/images; fi
+	if [ ! -d $(BWIDGETDIR)/lang ]; then $(MKDIR) $(BWIDGETDIR)/lang; fi
+	$(MAKE) $(DSTFILES)
+
+$(BWIDGETDIR)/%: %
+	$(INSTALL_DATA) $< $@

lib/external/bwidget/README

@@ -0,0 +1,149 @@
+07/09/1999
+BWidget ToolKit 1.2.1
+Copyright (c) 1998-1999 UNIFIX. 
+
+--------------------------------------------------------------------------
+WHAT IS BWIDGET ?
+
+The BWidget Toolkit is a high-level Widgets 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 Widget) but the concept is radically different because everything is 
+native so no platform compilation, no compiled extension library are needed. 
+The code is 100% Pure Tcl/Tk.
+
+
+--------------------------------------------------------------------------
+WIDGET LIST (1.2.1)
+
+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-1.2.1.tar.Z or BWidget-1.2.1.tar.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 <install_path>
+      % package require BWidget
+
+  To launch the demo, you need to cd into the demo subdirectory:
+      $ cd <install_path>/demo
+      $ wish demo.tcl
+
+- On Windows and others Platforms:
+  Uncompress the file BWidget-1.2.1.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-1.2   Root directory and BWidget Tcl sources
+   BWman        HTML manual pages
+   images       images used by BWidget
+   lang         Resources for language customization
+   demo         Demo sources
+
+
+--------------------------------------------------------------------------
+DOCUMENTATION
+
+HTML manual pages are available in the BWman subdirectory.
+Points to index.html for frame version with tree navigation,
+or to contents.html for no frame version.
+
+Look at http://www.unifix-online.com/BWidget for last revision
+of manual pages.
+
+
+--------------------------------------------------------------------------
+LICENSE
+
+BWidget ToolKit 1.2.1
+Copyright (c) 1998-1999 UNIFIX. 
+
+This library is free software; you can redistribute it and/or
+modify it under the terms of the GNU Library General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+This library is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with this library; if not, write to the
+Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA  02111-1307, USA.
+
+
+License is also in LICENSE.txt. You can find LGPL.txt too.
+
+--------------------------------------------------------------------------
+CONTACTS
+
+Old Mail         mailto:bwidget@unifix-online.com
+Old Home page    http://www.unifix-online.com/BWidget/
+New Home page    https://sourceforge.net/project/showfiles.php?group_id=12883
+
+Bug Report and FAQ : See Home Page
+
+
+

lib/external/bwidget/README.grass

@@ -0,0 +1,38 @@
+README.grass - written by Justin Hickey - jhickey@hpcc.nectec.or.th
+
+This directory contains an extension to Tcl/Tk (called BWidget) that provides
+new and enhanced widgets. It is not a new interpreter but simply Tcl/Tk files
+that provide the functionality. Therefore, there is nothing to compile and it
+only requires 2 lines of code in your Tcl/Tk script to use the new widgets.
+Some of the new widgets include
+
+    On mouse over help balloons
+    Tabbed notebook panes - like worksheets in Excel
+    Directory tree listing
+    Combination box or drop down option list
+    Progress bar
+    Many others
+
+For a demonstration of the new widgets available perform the following
+
+    cd demo
+    wish demo.tcl
+    
+It may take some time to load, but it demonstrates all or most of the new
+features.
+
+To use these widgets with GRASS Tcl/Tk scripts (including tcltkgrass) then add
+the following two lines to your main Tcl/Tk script
+
+    lappend auto_path $env(GISBASE)/bwidget
+    package require BWidget
+
+Then simply use the new widgets as if they were already part of Tcl/Tk. To find
+out more information on using the new widgets see the manual pages in
+./BWman/index.html
+
+For more information on BWidget see their home page at
+
+http://www.unifix-online.com/BWidget/
+
+or read the README file in this directory.

lib/external/bwidget/arrow.tcl

@@ -0,0 +1,548 @@
+# ------------------------------------------------------------------------------
+#  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::tkinclude ArrowButton button :cmd \
+        include {
+            -borderwidth -bd  -background -bg -relief
+            -highlightbackground -highlightcolor -highlightthickness -takefocus}
+
+    Widget::declare ArrowButton {
+        {-type                Enum button 0 {arrow button}}
+        {-dir                 Enum top    0 {top bottom left right}}
+        {-width               Int 15 0 {=0}}
+        {-height              Int 15 0 {=0}}
+        {-ipadx               Int 0  0 {=0}}
+        {-ipady               Int 0  0 {=0}}
+        {-clean               Int 2  0 {=0 =2}}
+        {-activeforeground    TkResource "" 0 button}
+        {-activebackground    TkResource "" 0 button}
+        {-disabledforeground  TkResource "" 0 button}
+        {-foreground          TkResource "" 0 button}
+        {-state               TkResource "" 0 button}
+
+        {-troughcolor     TkResource ""     0 scrollbar}
+        {-arrowbd         Int        1      0 {=1 =2}}
+        {-arrowrelief     Enum       raised 0 {raised sunken}}
+
+        {-command         String "" 0}
+        {-armcommand      String "" 0}
+        {-disarmcommand   String "" 0}
+        {-repeatdelay     Int 0 0 {=0}}
+        {-repeatinterval  Int 0 0 {=0}}
+
+        {-bd              Synonym -borderwidth}
+        {-fg              Synonym -foreground}
+    }
+    DynamicHelp::include ArrowButton balloon
+
+    proc ::ArrowButton { path args } { return [eval ArrowButton::create $path $args] }
+
+    proc use {} {}
+
+    bind BwArrowButton <Enter>           {ArrowButton::_enter %W}
+    bind BwArrowButton <Leave>           {ArrowButton::_leave %W}
+    bind BwArrowButton <ButtonPress-1>   {ArrowButton::_press %W}
+    bind BwArrowButton <ButtonRelease-1> {ArrowButton::_release %W}
+    bind BwArrowButton <Key-space>       {ArrowButton::invoke %W; break}
+    bind BwArrowButton <Return>          {ArrowButton::invoke %W; break}
+    bind BwArrowButton <Configure>       {ArrowButton::_redraw_whole %W %w %h}
+    bind BwArrowButton <Destroy>         {ArrowButton::_destroy %W}
+
+    variable _grab
+    variable _moved
+
+    array set _grab {current "" pressed "" oldstate "" oldrelief ""}
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ArrowButton::create
+# ------------------------------------------------------------------------------
+proc ArrowButton::create { path args } {
+    variable _moved
+
+    Widget::init ArrowButton $path $args
+
+    set w   [Widget::getoption $path -width]
+    set h   [Widget::getoption $path -height]
+    set bd  [Widget::getoption $path -borderwidth]
+    set ht  [Widget::getoption $path -highlightthickness]
+    set pad [expr {2*($bd+$ht)}]
+
+    eval canvas $path [Widget::subcget $path :cmd] \
+        -width [expr {$w-$pad}] -height [expr {$h-$pad}]
+    bindtags $path [list $path BwArrowButton [winfo toplevel $path] all]
+
+    DynamicHelp::sethelp $path $path 1
+
+    set _moved($path) 0
+
+    rename $path ::$path:cmd
+    proc ::$path { cmd args } "return \[eval ArrowButton::\$cmd $path \$args\]"
+
+    return $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:cmd configure \
+            -width [expr {$w-$pad}] -height [expr {$h-$pad}] \
+            -borderwidth $bd -highlightthickness $ht
+    } elseif { $ch2 } {
+        _redraw_whole $path [winfo width $path] [winfo height $path]
+    } else {
+        _redraw_relief $path
+        _redraw_state $path
+    }
+    DynamicHelp::sethelp $path $path
+
+    return $res
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ArrowButton::cget
+# ------------------------------------------------------------------------------
+proc ArrowButton::cget { path option } {
+    return [Widget::cget $path $option]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ArrowButton::invoke
+# ------------------------------------------------------------------------------
+proc ArrowButton::invoke { path } {
+    if { [string compare [Widget::getoption $path -state] "disabled"] } {
+        set oldstate [Widget::getoption $path -state]
+        if { ![string compare [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 compare [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:cmd cget -borderwidth] + [$path:cmd cget -highlightthickness] + 1}]
+    set clean [Widget::getoption $path -clean]
+    if { ![string compare $type "arrow"] } {
+        if { [set id [$path:cmd find withtag rect]] == "" } {
+            $path:cmd create rectangle $bd $bd [expr {$width-$bd-1}] [expr {$height-$bd-1}] -tags rect
+        } else {
+            $path:cmd coords $id $bd $bd [expr {$width-$bd-1}] [expr {$height-$bd-1}]
+        }
+        $path:cmd lower rect
+        set arrbd [Widget::getoption $path -arrowbd]
+        set bd    [expr {$bd+$arrbd-1}]
+    } else {
+        $path:cmd 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 compare $dir "top"] ||
+             ![string compare $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:cmd find withtag poly]] == "" } {
+                $path:cmd create polygon $x0 $y1 $x1 $y1 $xd $y0 -tags poly
+            } else {
+                $path:cmd coords $id $x0 $y1 $x1 $y1 $xd $y0
+            }
+            if { ![string compare $type "arrow"] } {
+                if { [set id [$path:cmd find withtag bot]] == "" } {
+                    $path:cmd create line $x0 $y1 $x1 $y1 $xd $y0 -tags bot
+                } else {
+                    $path:cmd coords $id $x0 $y1 $x1 $y1 $xd $y0
+                }
+                if { [set id [$path:cmd find withtag top]] == "" } {
+                    $path:cmd create line $x0 $y1 $xd $y0 -tags top
+                } else {
+                    $path:cmd coords $id $x0 $y1 $xd $y0
+                }
+                $path:cmd itemconfigure top -width $arrbd
+                $path:cmd itemconfigure bot -width $arrbd
+            } else {
+                $path:cmd delete top
+                $path:cmd delete bot
+            }
+        }
+        bottom {
+            set xd [expr {($x0+$x1)/2}]
+            if { [set id [$path:cmd find withtag poly]] == "" } {
+                $path:cmd create polygon $x1 $y0 $x0 $y0 $xd $y1 -tags poly
+            } else {
+                $path:cmd coords $id $x1 $y0 $x0 $y0 $xd $y1
+            }
+            if { ![string compare $type "arrow"] } {
+                if { [set id [$path:cmd find withtag top]] == "" } {
+                    $path:cmd create line $x1 $y0 $x0 $y0 $xd $y1 -tags top
+                } else {
+                    $path:cmd coords $id $x1 $y0 $x0 $y0 $xd $y1
+                }
+                if { [set id [$path:cmd find withtag bot]] == "" } {
+                    $path:cmd create line $x1 $y0 $xd $y1 -tags bot
+                } else {
+                    $path:cmd coords $id $x1 $y0 $xd $y1
+                }
+                $path:cmd itemconfigure top -width $arrbd
+                $path:cmd itemconfigure bot -width $arrbd
+            } else {
+                $path:cmd delete top
+                $path:cmd delete bot
+            }
+        }
+        left {
+            set yd [expr {($y0+$y1)/2}]
+            if { [set id [$path:cmd find withtag poly]] == "" } {
+                $path:cmd create polygon $x1 $y0 $x1 $y1 $x0 $yd -tags poly
+            } else {
+                $path:cmd coords $id $x1 $y0 $x1 $y1 $x0 $yd
+            }
+            if { ![string compare $type "arrow"] } {
+                if { [set id [$path:cmd find withtag bot]] == "" } {
+                    $path:cmd create line $x1 $y0 $x1 $y1 $x0 $yd -tags bot
+                } else {
+                    $path:cmd coords $id $x1 $y0 $x1 $y1 $x0 $yd
+                }
+                if { [set id [$path:cmd find withtag top]] == "" } {
+                    $path:cmd create line $x1 $y0 $x0 $yd -tags top
+                } else {
+                    $path:cmd coords $id $x1 $y0 $x0 $yd
+                }
+                $path:cmd itemconfigure top -width $arrbd
+                $path:cmd itemconfigure bot -width $arrbd
+            } else {
+                $path:cmd delete top
+                $path:cmd delete bot
+            }
+        }
+        right {
+            set yd [expr {($y0+$y1)/2}]
+            if { [set id [$path:cmd find withtag poly]] == "" } {
+                $path:cmd create polygon $x0 $y1 $x0 $y0 $x1 $yd -tags poly
+            } else {
+                $path:cmd coords $id $x0 $y1 $x0 $y0 $x1 $yd
+            }
+            if { ![string compare $type "arrow"] } {
+                if { [set id [$path:cmd find withtag top]] == "" } {
+                    $path:cmd create line $x0 $y1 $x0 $y0 $x1 $yd -tags top
+                } else {
+                    $path:cmd coords $id $x0 $y1 $x0 $y0 $x1 $yd
+                }
+                if { [set id [$path:cmd find withtag bot]] == "" } {
+                    $path:cmd create line $x0 $y1 $x1 $yd -tags bot
+                } else {
+                    $path:cmd coords $id $x0 $y1 $x1 $yd
+                }
+                $path:cmd itemconfigure top -width $arrbd
+                $path:cmd itemconfigure bot -width $arrbd
+            } else {
+                $path:cmd delete top
+                $path:cmd delete bot
+            }
+        }
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ArrowButton::_redraw_state
+# ------------------------------------------------------------------------------
+proc ArrowButton::_redraw_state { path } {
+    set state [Widget::getoption $path -state]
+    if { ![string compare [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:cmd configure -background [Widget::getoption $path $bg]
+        $path:cmd 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:cmd configure -background [Widget::getoption $path -background]
+        $path:cmd itemconfigure rect -fill $thrc -outline $thrc
+        $path:cmd itemconfigure poly -fill $bg   -outline $bg -stipple $stipple
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ArrowButton::_redraw_relief
+# ------------------------------------------------------------------------------
+proc ArrowButton::_redraw_relief { path } {
+    variable _moved
+
+    if { ![string compare [Widget::getoption $path -type] "button"] } {
+        if { ![string compare [Widget::getoption $path -relief] "sunken"] } {
+            if { !$_moved($path) } {
+                $path:cmd move poly 1 1
+                set _moved($path) 1
+            }
+        } else {
+            if { $_moved($path) } {
+                $path:cmd 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:cmd itemconfigure top -fill $top
+        $path:cmd 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::_destroy
+# ------------------------------------------------------------------------------
+proc ArrowButton::_destroy { path } {
+    variable _moved
+
+    Widget::destroy $path
+    unset _moved($path)
+    rename $path {}
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ArrowButton::_enter
+# ------------------------------------------------------------------------------
+proc ArrowButton::_enter { path } {
+    variable _grab
+
+    set _grab(current) $path
+    if { [string compare [Widget::getoption $path -state] "disabled"] } {
+        set _grab(oldstate) [Widget::getoption $path -state]
+        configure $path -state active
+        if { $_grab(pressed) == $path } {
+            if { ![string compare [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 _grab(current) ""
+    if { [string compare [Widget::getoption $path -state] "disabled"] } {
+        configure $path -state $_grab(oldstate)
+        if { $_grab(pressed) == $path } {
+            if { ![string compare [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
+
+    if { [string compare [Widget::getoption $path -state] "disabled"] } {
+        set _grab(pressed) $path
+            if { ![string compare [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
+
+    if { $_grab(pressed) == $path } {
+        set _grab(pressed) ""
+            if { ![string compare [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 compare [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 compare [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"
+    }
+}
+

lib/external/bwidget/bitmap.tcl

@@ -0,0 +1,92 @@
+# ------------------------------------------------------------------------------
+#  bitmap.tcl
+#  This file is part of Unifix BWidget Toolkit
+#  $Id$
+# ------------------------------------------------------------------------------
+#  Index of commands:
+#     - Bitmap::get
+#     - Bitmap::_init
+# ------------------------------------------------------------------------------
+namespace eval Bitmap {
+    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 compare $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 compare $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 $env(BWIDGET_LIBRARY) images]]
+    set supp [image types]
+    foreach {type ext} $_types {
+        if { [lsearch $supp $type] != -1} {
+            set _bmp($ext) $type
+        }
+    }
+}
+
+
+Bitmap::_init

lib/external/bwidget/button.tcl

@@ -0,0 +1,302 @@
+# ------------------------------------------------------------------------------
+#  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::tkinclude Button button :cmd \
+        remove {-command -relief -text -textvariable -underline}
+
+    Widget::declare Button {
+        {-name            String "" 0}
+        {-text            String "" 0}
+        {-textvariable    String "" 0}
+        {-underline       Int    -1 0 {=-1}}
+        {-armcommand      String "" 0}
+        {-disarmcommand   String "" 0}
+        {-command         String "" 0}
+        {-repeatdelay     Int    0  0 {=0 ""}}
+        {-repeatinterval  Int    0  0 {=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 <Enter>           {Button::_enter %W}
+    bind BwButton <Leave>           {Button::_leave %W}
+    bind BwButton <ButtonPress-1>   {Button::_press %W}
+    bind BwButton <ButtonRelease-1> {Button::_release %W}
+    bind BwButton <Key-space>       {Button::invoke %W; break}
+    bind BwButton <Return>          {Button::invoke %W; break}
+    bind BwButton <Destroy>         {Widget::destroy %W; rename %W {}}
+
+    proc ::Button { path args } { return [eval Button::create $path $args] }
+    proc use {} {}
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Button::create
+# ------------------------------------------------------------------------------
+proc Button::create { path args } {
+    Widget::init Button $path $args
+
+    set relief [Widget::getoption $path -relief]
+    if { ![string compare $relief "link"] } {
+        set relief "flat"
+    }
+
+    set var [Widget::getoption $path -textvariable]
+    if {  ![string length $var] } {
+        set desc [BWidget::getname [Widget::getoption $path -name]]
+        if { [llength $desc] } {
+            set text  [lindex $desc 0]
+            set under [lindex $desc 1]
+            Widget::setoption $path -text $text
+            Widget::setoption $path -underline $under
+        } else {
+            set text  [Widget::getoption $path -text]
+            set under [Widget::getoption $path -underline]
+        }
+    } else {
+        set under -1
+        set text  ""
+        Widget::setoption $path -underline $under
+    }
+
+    eval button $path [Widget::subcget $path :cmd] \
+        [list -relief $relief -text $text -underline $under -textvariable $var]
+    bindtags $path [list $path BwButton [winfo toplevel $path] all]
+
+    set accel [string tolower [string index $text $under]]
+    if { $accel != "" } {
+        bind [winfo toplevel $path] <Alt-$accel> "Button::invoke $path"
+    }
+
+    DynamicHelp::sethelp $path $path 1
+
+    rename $path ::$path:cmd
+    proc ::$path { cmd args } "return \[eval Button::\$cmd $path \$args\]"
+
+    return $path
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Button::configure
+# ------------------------------------------------------------------------------
+proc Button::configure { path args } {
+    set oldunder [$path:cmd cget -underline]
+    if { $oldunder != -1 } {
+        set oldaccel [string tolower [string index [$path:cmd cget -text] $oldunder]]
+    } else {
+        set oldaccel ""
+    }
+    set res [Widget::configure $path $args]
+
+    set rc [Widget::hasChanged $path -relief relief]
+    set sc [Widget::hasChanged $path -state  state]
+
+    if { $rc || $sc } {
+        if { ![string compare $relief "link"] } {
+            if { ![string compare $state "active"] } {
+                set relief "raised"
+            } else {
+                set relief "flat"
+            }
+        }
+        $path:cmd configure -relief $relief -state $state
+    }
+
+    set cv [Widget::hasChanged $path -textvariable var]
+    set cn [Widget::hasChanged $path -name name]
+    set ct [Widget::hasChanged $path -text text]
+    set cu [Widget::hasChanged $path -underline under]
+
+    if { $cv || $cn || $ct || $cu } {
+        if {  ![string length $var] } {
+            set desc [BWidget::getname $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]
+        bind $top <Alt-$oldaccel> {}
+        set accel [string tolower [string index $text $under]]
+        if { $accel != "" } {
+            bind $top <Alt-$accel> "Button::invoke $path"
+        }
+        $path:cmd configure -text $text -underline $under -textvariable $var
+    }
+    DynamicHelp::sethelp $path $path
+
+    return $res
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Button::cget
+# ------------------------------------------------------------------------------
+proc Button::cget { path option } {
+    return [Widget::cget $path $option]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Button::invoke
+# ------------------------------------------------------------------------------
+proc Button::invoke { path } {
+    if { [string compare [$path:cmd cget -state] "disabled"] } {
+	$path:cmd configure -state active -relief sunken
+	update idletasks
+        if { [set cmd [Widget::getoption $path -armcommand]] != "" } {
+            uplevel \#0 $cmd
+        }
+	after 100
+        set relief [Widget::getoption $path -relief]
+        if { ![string compare $relief "link"] } {
+            set relief flat
+        }
+	$path:cmd configure \
+            -state  [Widget::getoption $path -state] \
+            -relief $relief
+        if { [set cmd [Widget::getoption $path -disarmcommand]] != "" } {
+            uplevel \#0 $cmd
+        }
+        if { [set cmd [Widget::getoption $path -command]] != "" } {
+            uplevel \#0 $cmd
+        }
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Button::_enter
+# ------------------------------------------------------------------------------
+proc Button::_enter { path } {
+    variable _current
+    variable _pressed
+
+    set _current $path
+    if { [string compare [$path:cmd cget -state] "disabled"] } {
+        $path:cmd configure -state active
+        if { $_pressed == $path } {
+            $path:cmd configure -relief sunken
+        } elseif { ![string compare [Widget::getoption $path -relief] "link"] } {
+            $path:cmd configure -relief raised
+        }
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Button::_leave
+# ------------------------------------------------------------------------------
+proc Button::_leave { path } {
+    variable _current
+    variable _pressed
+
+    set _current ""
+    if { [string compare [$path:cmd cget -state] "disabled"] } {
+        $path:cmd configure -state [Widget::getoption $path -state]
+        set relief [Widget::getoption $path -relief]
+        if { $_pressed == $path } {
+            if { ![string compare $relief "link"] } {
+                set relief raised
+            }
+            $path:cmd configure -relief $relief
+        } elseif { ![string compare $relief "link"] } {
+            $path:cmd configure -relief flat
+        }
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Button::_press
+# ------------------------------------------------------------------------------
+proc Button::_press { path } {
+    variable _pressed
+
+    if { [string compare [$path:cmd cget -state] "disabled"] } {
+        set _pressed $path
+	$path:cmd configure -relief 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 "Button::_repeat $path"
+            }
+        }
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Button::_release
+# ------------------------------------------------------------------------------
+proc Button::_release { path } {
+    variable _current
+    variable _pressed
+
+    if { $_pressed == $path } {
+        set _pressed ""
+        set relief [Widget::getoption $path -relief]
+        if { ![string compare $relief "link"] } {
+            set relief raised
+        }
+        $path:cmd configure -relief $relief
+        if { [set cmd [Widget::getoption $path -disarmcommand]] != "" } {
+            uplevel \#0 $cmd
+        }
+        if { $_current == $path &&
+             [string compare [$path:cmd cget -state] "disabled"] &&
+             [set cmd [Widget::getoption $path -command]] != "" } {
+            uplevel \#0 $cmd
+        }
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Button::_repeat
+# ------------------------------------------------------------------------------
+proc Button::_repeat { path } {
+    variable _current
+    variable _pressed
+
+    if { $_current == $path && $_pressed == $path &&
+         [string compare [$path:cmd cget -state] "disabled"] &&
+         [set cmd [Widget::getoption $path -armcommand]] != "" } {
+        uplevel \#0 $cmd
+    }
+    if { $_pressed == $path &&
+         ([set delay [Widget::getoption $path -repeatinterval]] > 0 ||
+          [set delay [Widget::getoption $path -repeatdelay]]    > 0) } {
+        after $delay "Button::_repeat $path"
+    }
+}
+

lib/external/bwidget/buttonbox.tcl

@@ -0,0 +1,226 @@
+# ------------------------------------------------------------------------------
+#  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 {
+    Button::use
+
+    Widget::declare ButtonBox {
+        {-background  TkResource ""         0 frame}
+        {-orient      Enum       horizontal 1 {horizontal vertical}}
+        {-homogeneous Boolean    1          1}
+        {-spacing     Int        10         0 {=0}}
+        {-padx        TkResource ""         0 button}
+        {-pady        TkResource ""         0 button}
+        {-default     Int        -1         0 {=-1}} 
+        {-bg          Synonym    -background}
+    }
+
+    Widget::addmap ButtonBox "" :cmd {-background {}}
+
+    proc ::ButtonBox { path args } { return [eval ButtonBox::create $path $args] }
+    proc use {} {}
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ButtonBox::create
+# ------------------------------------------------------------------------------
+proc ButtonBox::create { path args } {
+    Widget::init ButtonBox $path $args
+
+    variable $path
+    upvar 0  $path data
+
+    eval frame $path [Widget::subcget $path :cmd] -takefocus 0 -highlightthickness 0
+
+    set data(default)  [Widget::getoption $path -default]
+    set data(nbuttons) 0
+    set data(max)      0
+
+    bind $path <Destroy> "ButtonBox::_destroy $path"
+
+    rename $path ::$path:cmd
+    proc ::$path { cmd args } "return \[eval ButtonBox::\$cmd $path \$args\]"
+
+    return $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)
+        }
+    }
+
+    return $res
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ButtonBox::cget
+# ------------------------------------------------------------------------------
+proc ButtonBox::cget { path option } {
+    return [Widget::cget $path $option]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ButtonBox::add
+# ------------------------------------------------------------------------------
+proc ButtonBox::add { path args } {
+    variable $path
+    upvar 0  $path data
+
+    set but     $path.b$data(nbuttons)
+    set spacing [Widget::getoption $path -spacing]
+
+    if { $data(nbuttons) == $data(default) } {
+        set style active
+    } elseif { $data(default) == -1 } {
+        set style disabled
+    } else {
+        set style normal
+    }
+
+    eval Button::create $but \
+        -background [Widget::getoption $path -background]\
+        -padx       [Widget::getoption $path -padx] \
+        -pady       [Widget::getoption $path -pady] \
+        $args \
+        -default $style
+
+    set idx [expr {2*$data(nbuttons)}]
+    if { ![string compare [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) } {
+                for {set i 0} {$i < $data(nbuttons)} {incr i} {
+                    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
+        }
+        if { $data(nbuttons) > 0 } {
+            grid columnconfigure $path [expr {$idx-1}] -minsize $spacing
+        }
+    } else {
+        grid $but -column 0 -row $idx -sticky nsew
+        grid rowconfigure $path $idx -weight 0
+        if { $data(nbuttons) > 0 } {
+            grid rowconfigure $path [expr {$idx-1}] -minsize $spacing
+        }
+    }
+
+    incr data(nbuttons)
+
+    return $but
+}
+
+
+# ------------------------------------------------------------------------------
+#  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 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 } {
+    if { ![string compare $index "default"] } {
+        set res [Widget::getoption $path -default]
+    } elseif { ![string compare $index "end"] || ![string compare $index "last"] } {
+        variable $path
+        upvar 0  $path data
+
+        set res [expr {$data(nbuttons)-1}]
+    } else {
+        set res $index
+    }
+    return $res
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ButtonBox::_destroy
+# ------------------------------------------------------------------------------
+proc ButtonBox::_destroy { path } {
+    variable $path
+    upvar 0  $path data
+
+    Widget::destroy $path
+    unset data
+    rename $path {}
+}

lib/external/bwidget/color.tcl

@@ -0,0 +1,314 @@
+# ------------------------------------------------------------------------------
+#  color.tcl
+#  This file is part of Unifix BWidget Toolkit
+# ------------------------------------------------------------------------------
+#  Index of commands:
+#     - SelectColor::create
+#     - SelectColor::setcolor
+#     - SelectColor::_destroy
+#     - SelectColor::_update_var
+#     - SelectColor::_post_menu
+#     - SelectColor::_tk_choose_color
+#     - SelectColor::_activate
+# ------------------------------------------------------------------------------
+
+namespace eval SelectColor {
+    Widget::declare SelectColor {
+        {-title    String     "" 0}
+        {-parent   String     "" 0}
+        {-type     Enum       dialog 1 {dialog menubutton}}
+        {-command  String     ""     0}
+        {-color    TkResource ""     0 {label -background}}
+        {-variable String     ""     0}
+        {-width    TkResource 15     0 frame}
+        {-height   TkResource 15     0 frame}
+    }
+
+    Widget::addmap      SelectColor "" :cmd {-width {} -height {}}
+    Widget::syncoptions SelectColor "" :cmd {-color -background}
+
+    variable _tabcolors {
+        \#0000ff \#000099 \#000000 white
+        \#00ff00 \#009900 \#333333 white
+        \#00ffff \#009999 \#666666 white
+        \#ff0000 \#990000 \#999999 white
+        \#ff00ff \#990099 \#cccccc white
+        \#ffff00 \#999900 \#ffffff
+    }
+
+    # bindings
+    bind SelectColor <ButtonPress-1> {SelectColor::_post_menu %W %X %Y}
+    bind SelectColor <Destroy>       {SelectColor::_destroy %W}
+
+    variable _widget
+
+    proc ::SelectColor { path args } { return [eval SelectColor::create $path $args] }
+    proc use {} {}
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command SelectColor::create
+# ------------------------------------------------------------------------------
+proc SelectColor::create { path args } {
+    variable _tabcolors
+    variable _widget
+
+    Widget::init SelectColor $path $args
+
+    if { ![string compare [Widget::getoption $path -type] "menubutton"] } {
+        if { [set var [Widget::getoption $path -variable]] != "" } {
+            set _widget($path,var) $var
+            if { [GlobalVar::exists $var] } {
+                Widget::setoption $path -color [GlobalVar::getvar $var]
+            } else {
+                GlobalVar::setvar $var [Widget::getoption $path -color]
+            }
+            GlobalVar::tracevar variable $var w "SelectColor::_update_var $path"
+        } else {
+            set _widget($path,var) ""
+        }
+
+        eval frame $path [Widget::subcget $path :cmd] \
+            -background [Widget::getoption $path -color] \
+            -relief raised -borderwidth 2 -highlightthickness 0
+        bindtags $path [list $path SelectColor . all]
+        set _widget($path,idx) 0
+
+        rename $path ::$path:cmd
+        proc ::$path { cmd args } "return \[eval SelectColor::\$cmd $path \$args\]"
+    } else {
+        set parent [Widget::getoption $path -parent]
+        set title  [Widget::getoption $path -title]
+        set lopt   [list -initialcolor [Widget::getoption $path -color]]
+        if { [winfo exists $parent] } {
+            lappend lopt -parent $parent
+        }
+        if { $title != "" } {
+            lappend lopt -title $title
+        }
+        set col [eval tk_chooseColor $lopt]
+        Widget::destroy $path
+        return $col
+    }
+
+    return $path
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command SelectColor::configure
+# ------------------------------------------------------------------------------
+proc SelectColor::configure { path args } {
+    variable _widget
+
+    set res [Widget::configure $path $args]
+
+    if { [Widget::hasChanged $path -variable var] } {
+        if { [string length $_widget($path,var)] } {
+            GlobalVar::tracevar vdelete $_widget($path,var) w "SelectColor::_update_var $path"
+        }
+        set _widget($path,var) $var
+        if { [string length $_widget($path,var)] } {
+            Widget::hasChanged $path -color curval
+            if { [GlobalVar::exists $_widget($path,var)] } {
+                Widget::setoption $path -color [set curval [GlobalVar::getvar $_widget($path,var)]]
+            } else {
+                GlobalVar::setvar $_widget($path,var) $curval
+            }
+            GlobalVar::tracevar variable $_widget($path,var) w "SelectColor::_update_var $path"
+            $path:cmd configure -background $curval
+        }
+    }
+
+    if { [Widget::hasChanged $path -color curval] } {
+        if { [string length $_widget($path,var)] } {
+            Widget::setoption $path -color [GlobalVar::getvar $_widget($path,var)]
+        } else {
+            $path:cmd configure -background $curval
+        }
+    }
+    return $res
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command SelectColor::cget
+# ------------------------------------------------------------------------------
+proc SelectColor::cget { path option } {
+    return [Widget::cget $path $option]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command SelectColor::setcolor
+# ------------------------------------------------------------------------------
+proc SelectColor::setcolor { index color } {
+    variable _tabcolors
+    variable _widget
+
+    if { $index >= 1 && $index <= 5 } {
+        set idx        [expr {int($idx) * 3}]
+        set _tabcolors [lreplace $_tabcolors $idx $idx $color]
+        return 1
+    }
+    return 0
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command SelectColor::_destroy
+# ------------------------------------------------------------------------------
+proc SelectColor::_destroy { path } {
+    variable _widget
+
+    if { [string length $_widget($path,var)] } {
+        GlobalVar::tracevar vdelete $_widget($path,var) w "SelectColor::_update_var $path"
+    }
+    unset _widget($path,var)
+    unset _widget($path,idx)
+    Widget::destroy $path
+    rename $path {}
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command SelectColor::_update_var
+# ------------------------------------------------------------------------------
+proc SelectColor::_update_var { path args } {
+    variable _tabcolors
+    variable _widget
+
+    set col [GlobalVar::getvar $_widget($path,var)]
+    $path:cmd configure -background $col
+    Widget::setoption $path -color $col
+    set _widget($path,idx) [lsearch $_tabcolors $col]
+    if { $_widget($path,idx) == -1 } {
+        set _widget($path,idx) 0
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command SelectColor::_post_menu
+# ------------------------------------------------------------------------------
+proc SelectColor::_post_menu { path X Y } {
+    global   env
+    variable _tabcolors
+    variable _widget
+
+    if { [winfo exists $path.menu] } {
+        if { [string compare [winfo containing $X $Y] $path] } {
+            BWidget::grab release $path
+            destroy $path.menu
+        }
+        return
+    }
+
+    set top [menu $path.menu]
+    wm withdraw $top
+    wm transient $top [winfo toplevel $path]
+    set col 0
+    set row 0
+    set count 0
+    set frame [frame $top.frame -highlightthickness 0 -relief raised -borderwidth 2]
+    foreach color $_tabcolors {
+        set f [frame $frame.c$count \
+                   -relief flat -bd 0 -highlightthickness 1 \
+                   -width 16 -height 16 -background $color]
+        bind $f <ButtonRelease-1> "SelectColor::_activate $path %W"
+        bind $f <Enter>           {focus %W}
+        grid $f -column $col -row $row -padx 1 -pady 1
+        bindtags $f $f
+        incr row
+        incr count
+        if { $row == 4 } {
+            set row 0
+            incr col
+        }
+    }
+    set f [label $frame.c$count \
+               -relief flat -bd 0 -highlightthickness 1 \
+               -width 16 -height 16 -image [Bitmap::get palette]]
+    grid $f -column $col -row $row -padx 1 -pady 1
+    bind $f <ButtonRelease-1> "SelectColor::_tk_choose_color $path"
+    bind $f <Enter>           {focus %W}
+    pack $frame
+
+    BWidget::place $top 0 0 below $path
+
+    wm deiconify $top
+    raise $top
+    focus $frame
+    focus $top.frame.c$_widget($path,idx)
+    BWidget::grab set $path
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command SelectColor::_tk_choose_color
+# ------------------------------------------------------------------------------
+proc SelectColor::_tk_choose_color { path } {
+    variable _tabcolors
+    variable _widget
+
+    BWidget::grab release $path
+    destroy $path.menu
+    set parent [Widget::getoption $path -parent]
+    set title  [Widget::getoption $path -title]
+    set lopt   [list -initialcolor [$path:cmd cget -background]]
+    if { [winfo exists $parent] } {
+        lappend lopt -parent $parent
+    }
+    if { $title != "" } {
+        lappend lopt -title $title
+    }
+    set col [eval tk_chooseColor $lopt]
+    if { $col != "" } {
+        if { $_widget($path,idx) % 4 == 3 } {
+            set idx $_widget($path,idx)
+        } else {
+            set idx -1
+            for {set i 3} {$i < 15} {incr i 4} {
+                if { [lindex $_tabcolors $i] == "white" } {
+                    set idx $i
+                    break
+                }
+            }
+        }
+        if { $idx != -1 } {
+            set _tabcolors [lreplace $_tabcolors $idx $idx $col]
+            set _widget($path,idx) $idx
+        }
+        if { [info exists _widget($path,var)] } {
+            GlobalVar::setvar $_widget($path,var) $col
+        }
+        if { [set cmd [Widget::getoption $path -command]] != "" } {
+            uplevel \#0 $cmd
+        }
+        $path:cmd configure -background $col
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command SelectColor::_activate
+# ------------------------------------------------------------------------------
+proc SelectColor::_activate { path cell } {
+    variable _tabcolors
+    variable _widget
+
+    BWidget::grab release $path
+    set col [$cell cget -background]
+    destroy $path.menu
+    if { [string length $_widget($path,var)] } {
+        GlobalVar::setvar $_widget($path,var) $col
+    }
+    Widget::setoption $path -color $col
+    $path:cmd configure -background $col
+
+    if { [set cmd [Widget::getoption $path -command]] != "" } {
+        uplevel \#0 $cmd
+    }
+    set _widget($path,idx) [string range [lindex [split $cell "."] end] 1 end]
+}

lib/external/bwidget/combobox.tcl

@@ -0,0 +1,340 @@
+# ------------------------------------------------------------------------------
+#  combobox.tcl
+#  This file is part of Unifix BWidget Toolkit
+#  $Id$
+# ------------------------------------------------------------------------------
+#  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
+# ------------------------------------------------------------------------------
+
+namespace eval ComboBox {
+    ArrowButton::use
+    Entry::use
+    LabelFrame::use
+
+    Widget::bwinclude ComboBox LabelFrame .labf \
+        rename     {-text -label} \
+        remove     {-focus} \
+        prefix     {label -justify -width -anchor -height -font} \
+        initialize {-relief sunken -borderwidth 2}
+
+    Widget::bwinclude ComboBox Entry .e \
+        remove {-relief -bd -borderwidth -bg -fg} \
+        rename {-foreground -entryfg -background -entrybg}
+
+    Widget::declare ComboBox {
+        {-height      TkResource 0  0 listbox}
+        {-values      String     "" 0}
+        {-modifycmd   String     "" 0}
+        {-postcommand String     "" 0}
+    }
+
+    Widget::addmap ComboBox "" :cmd {-background {}}
+    Widget::addmap ComboBox ArrowButton .a \
+        {-foreground {} -background {} -disabledforeground {} -state {}}
+
+    Widget::syncoptions ComboBox Entry .e {-text {}}
+    Widget::syncoptions ComboBox LabelFrame .labf {-label -text -underline {}}
+
+    ::bind BwComboBox <FocusIn> {focus %W.labf}
+    ::bind BwComboBox <Destroy> {Widget::destroy %W; rename %W {}}
+
+    proc ::ComboBox { path args } { return [eval ComboBox::create $path $args] }
+    proc use {} {}
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ComboBox::create
+# ------------------------------------------------------------------------------
+proc ComboBox::create { path args } {
+    Widget::init ComboBox $path $args
+
+    frame $path -background [Widget::getoption $path -background] \
+        -highlightthickness 0 -bd 0 -relief flat -takefocus 0
+
+    bindtags $path [list $path BwComboBox [winfo toplevel $path] all]
+
+    set labf  [eval LabelFrame::create $path.labf [Widget::subcget $path .labf] \
+                   -focus $path.e]
+    set entry [eval Entry::create $path.e [Widget::subcget $path .e] \
+                   -relief flat -borderwidth 0]
+
+    set width  11
+    set height [winfo reqheight $entry]
+    set arrow [eval ArrowButton::create $path.a [Widget::subcget $path .a] \
+                   -width $width -height $height \
+                   -highlightthickness 0 -borderwidth 1 -takefocus 0 \
+                   -dir   bottom \
+                   -type  button \
+                   -command [list "ComboBox::_mapliste $path"]]
+
+    set frame [LabelFrame::getframe $labf]
+
+    pack $arrow -in $frame -side right -fill y
+    pack $entry -in $frame -side left  -fill both -expand yes
+    pack $labf  -fill x -expand yes
+
+    if { [Widget::getoption $path -editable] == 0 } {
+        ::bind $entry <ButtonPress-1> "ArrowButton::invoke $path.a"
+    } else {
+        ::bind $entry <ButtonPress-1> "ComboBox::_unmapliste $path"
+    }
+
+    ::bind $path  <ButtonPress-1> "ComboBox::_unmapliste $path"
+    ::bind $entry <Key-Up>        "ComboBox::_modify_value $path previous"
+    ::bind $entry <Key-Down>      "ComboBox::_modify_value $path next"
+    ::bind $entry <Key-Prior>     "ComboBox::_modify_value $path first"
+    ::bind $entry <Key-Next>      "ComboBox::_modify_value $path last"
+
+    rename $path ::$path:cmd
+    proc ::$path { cmd args } "return \[eval ComboBox::\$cmd $path \$args\]"
+
+    return $path
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ComboBox::configure
+# ------------------------------------------------------------------------------
+proc ComboBox::configure { path args } {
+    set res [Widget::configure $path $args]
+
+    if { [Widget::hasChanged $path -values values] |
+         [Widget::hasChanged $path -height h] |
+         [Widget::hasChanged $path -font f] } {
+        destroy $path.shell.listb
+    }
+
+    if { [Widget::hasChanged $path -editable ed] } {
+        if { $ed } {
+            ::bind $path.e <ButtonPress-1> "ComboBox::_unmapliste $path"
+        } else {
+            ::bind $path.e <ButtonPress-1> "ArrowButton::invoke $path.a"
+        }
+    }
+
+    return $res
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ComboBox::cget
+# ------------------------------------------------------------------------------
+proc ComboBox::cget { path option } {
+    Widget::setoption $path -text [Entry::cget $path.e -text]
+    return [Widget::cget $path $option]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ComboBox::setvalue
+# ------------------------------------------------------------------------------
+proc ComboBox::setvalue { path index } {
+    set values [Widget::getoption $path -values]
+    set value  [Entry::cget $path.e -text]
+    switch -- $index {
+        next {
+            if { [set idx [lsearch $values $value]] != -1 } {
+                incr idx
+            } else {
+                set idx [lsearch $values "$value*"]
+            }
+        }
+        previous {
+            if { [set idx [lsearch $values $value]] != -1 } {
+                incr idx -1
+            } else {
+                set idx [lsearch $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 { [catch {string compare [expr {int($idx)}] $idx} res] || $res != 0 } {
+                    return -code error "bad index \"$index\""
+                }
+            } else {
+                return -code error "bad index \"$index\""
+            }
+        }
+    }
+    if { $idx >= 0 && $idx < [llength $values] } {
+        set newval [lindex $values $idx]
+        Widget::setoption $path -text $newval
+        if { [set varname [Entry::cget $path.e -textvariable]] != "" } {
+            GlobalVar::setvar $varname $newval
+        } else {
+            Entry::configure $path.e -text $newval
+        }
+        return 1
+    }
+    return 0
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ComboBox::getvalue
+# ------------------------------------------------------------------------------
+proc ComboBox::getvalue { path } {
+    set values [Widget::getoption $path -values]
+    set value  [Entry::cget $path.e -text]
+
+    return [lsearch $values $value]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ComboBox::bind
+# ------------------------------------------------------------------------------
+proc ComboBox::bind { path args } {
+    return [eval ::bind $path.e $args]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ComboBox::_create_popup
+# ------------------------------------------------------------------------------
+proc ComboBox::_create_popup { path } {
+    set shell [menu $path.shell -tearoff 0 -relief flat -bd 0]
+    wm overrideredirect $shell 1
+    wm withdraw $shell
+    wm transient $shell [winfo toplevel $path]
+    wm group $shell [winfo toplevel $path]
+    set lval [Widget::getoption $path -values]
+    set h    [Widget::getoption $path -height] 
+    set sb   0
+    if { $h <= 0 } {
+        set len [llength $lval]
+        if { $len < 3 } {
+            set h 3
+        } elseif { $len > 10 } {
+            set h  10
+	    set sb 1
+        }
+    }
+    set frame  [frame $shell.frame -relief sunken -bd 2]
+    set listb  [listbox $shell.listb -relief flat -bd 0 -highlightthickness 0 \
+                    -exportselection false \
+                    -font   [Widget::getoption $path -font]  \
+                    -height $h]
+
+    if { $sb } {
+	set scroll [scrollbar $shell.scroll \
+		-orient vertical \
+		-command "$shell.listb yview" \
+		-highlightthickness 0 -takefocus 0 -width 9]
+	$listb configure -yscrollcommand "$scroll set"
+    }
+    $listb delete 0 end
+    foreach val $lval {
+        $listb insert end $val
+    }
+
+    if { $sb } {
+	pack $scroll -in $frame -side right -fill y
+    }
+    pack $listb  -in $frame -side left  -fill both -expand yes
+    pack $frame  -fill both -expand yes -padx 1 -padx 1
+
+    ::bind $listb <ButtonRelease-1> "ComboBox::_select $path @%x,%y"
+    ::bind $listb <Return>          "ComboBox::_select $path active"
+    ::bind $listb <Escape>          "ComboBox::_unmapliste $path"
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ComboBox::_mapliste
+# ------------------------------------------------------------------------------
+proc ComboBox::_mapliste { path } {
+    set listb $path.shell.listb
+    if { [winfo exists $path.shell] } {
+	_unmapliste $path
+        return
+    }
+
+    if { [Widget::getoption $path -state] == "disabled" } {
+        return
+    }
+    if { [set cmd [Widget::getoption $path -postcommand]] != "" } {
+        uplevel \#0 $cmd
+    }
+    if { ![llength [Widget::getoption $path -values]] } {
+        return
+    }
+    _create_popup $path
+
+    ArrowButton::configure $path.a -dir top
+    $listb selection clear 0 end
+    set values [$listb get 0 end]
+    set curval [Entry::cget $path.e -text]
+    if { [set idx [lsearch $values $curval]] != -1 ||
+         [set idx [lsearch $values "$curval*"]] != -1 } {
+        $listb selection set $idx
+        $listb activate $idx
+        $listb see $idx
+    } else {
+        $listb activate 0
+        $listb see 0
+    }
+
+    set frame [LabelFrame::getframe $path.labf]
+    BWidget::place $path.shell [winfo width $frame] 0 below $frame
+    wm deiconify $path.shell
+    raise $path.shell
+    BWidget::grab global $path
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ComboBox::_unmapliste
+# ------------------------------------------------------------------------------
+proc ComboBox::_unmapliste { path } {
+    BWidget::grab release $path
+    destroy $path.shell
+    ArrowButton::configure $path.a -dir bottom
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ComboBox::_select
+# ------------------------------------------------------------------------------
+proc ComboBox::_select { path index } {
+    set index [$path.shell.listb index $index]
+    _unmapliste $path
+    if { $index != -1 } {
+        if { [setvalue $path @$index] } {
+            if { [set cmd [Widget::getoption $path -modifycmd]] != "" } {
+                uplevel \#0 $cmd
+            }
+        }
+    }
+    return -code break
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ComboBox::_modify_value
+# ------------------------------------------------------------------------------
+proc ComboBox::_modify_value { path direction } {
+    if { [setvalue $path $direction] } {
+        if { [set cmd [Widget::getoption $path -modifycmd]] != "" } {
+            uplevel \#0 $cmd
+        }
+    }
+}

lib/external/bwidget/dialog.tcl

@@ -0,0 +1,290 @@
+# ------------------------------------------------------------------------------
+#  dialog.tcl
+#  This file is part of Unifix BWidget Toolkit
+#  $Id$
+# ------------------------------------------------------------------------------
+#  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
+# ------------------------------------------------------------------------------
+
+namespace eval Dialog {
+    ButtonBox::use
+
+    Widget::bwinclude Dialog ButtonBox .bbox \
+        remove     {-orient} \
+        initialize {-spacing 10 -padx 10}
+
+    Widget::declare Dialog {
+        {-title       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 {=-1 ""}}
+        {-parent      String     ""       0}
+        {-side        Enum       bottom   1 {bottom left top right}}
+        {-anchor      Enum       c        1 {n e w s c}}
+    }
+
+    Widget::addmap Dialog "" :cmd   {-background {}}
+    Widget::addmap Dialog "" .frame {-background {}}
+
+    proc ::Dialog { path args } { return [eval Dialog::create $path $args] }
+    proc use {} {}
+
+    bind BwDialog <Destroy> {Dialog::enddialog %W -1; Dialog::_destroy %W}
+
+    variable _widget
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Dialog::create
+# ------------------------------------------------------------------------------
+proc Dialog::create { path args } {
+    global   tcl_platform
+    variable _widget
+
+    Widget::init Dialog $path $args
+    set bg [Widget::getoption $path -background]
+    if { ![string compare $tcl_platform(platform) "unix"] } {
+        toplevel $path -relief raised -borderwidth 1 -background $bg
+    } else {
+        toplevel $path -relief flat   -borderwidth 0 -background $bg
+    }
+    bindtags $path [list $path BwDialog all]
+    wm overrideredirect $path 1
+    wm title $path [Widget::getoption $path -title]
+    set parent [Widget::getoption $path -parent]
+    if { ![winfo exists $parent] } {
+        set parent [winfo parent $path]
+    }
+    wm transient $path [winfo toplevel $parent]
+    wm withdraw $path
+
+    set side [Widget::getoption $path -side]
+    if { ![string compare $side "left"] || ![string compare $side "right"] } {
+        set orient vertical
+    } else {
+        set orient horizontal
+    }
+
+    set bbox  [eval ButtonBox::create $path.bbox [Widget::subcget $path .bbox] \
+                   -orient $orient]
+    set frame [frame $path.frame -relief flat -borderwidth 0 -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 <Escape>  "ButtonBox::invoke $path.bbox [Widget::getoption $path -cancel]"
+    bind $path <Return>  "ButtonBox::invoke $path.bbox default"
+
+    rename $path ::$path:cmd
+    proc ::$path { cmd args } "return \[eval Dialog::\$cmd $path \$args\]"
+
+    return $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 res [eval ButtonBox::add $path.bbox \
+                 -command [list "Dialog::enddialog $path $_widget($path,nbut)"] $args]
+    incr _widget($path,nbut)
+    return $res
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Dialog::itemconfigure
+# ------------------------------------------------------------------------------
+proc Dialog::itemconfigure { path index args } {
+    return [eval 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 ""}} {
+    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 compare $side "left"] || ![string compare $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
+    }
+
+    if { [winfo exists $parent] } {
+        BWidget::place $path 0 0 center $parent
+    } else {
+        BWidget::place $path 0 0 center
+    }
+    update idletasks
+    wm overrideredirect $path 0
+    wm deiconify $path
+
+    tkwait visibility $path
+    BWidget::focus set $path
+    if { [winfo exists $focus] } {
+        focus -force $focus
+    } else {
+        ButtonBox::setfocus $path.bbox default
+    }
+
+    if { [set grab [Widget::getoption $path -modal]] != "none" } {
+        BWidget::grab $grab $path
+        catch {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
+
+    BWidget::grab  release $path
+    BWidget::focus release $path
+    catch {unset _widget($path,result)}
+    unset _widget($path,realized)
+    unset _widget($path,nbut)
+
+    Widget::destroy $path
+    rename $path {}
+}

lib/external/bwidget/dragsite.tcl

@@ -0,0 +1,190 @@
+# ------------------------------------------------------------------------------
+#  dragsite.tcl
+#  This file is part of Unifix BWidget Toolkit
+#  $Id$
+# ------------------------------------------------------------------------------
+#  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::declare DragSite {
+        {-dragevent     Enum   1  0 {1 2 3}}
+        {-draginitcmd   String "" 0}
+        {-dragendcmd    String "" 0}
+    }
+
+    variable _topw ".drag"
+    variable _tabops
+    variable _state
+    variable _x0
+    variable _y0
+
+    bind BwDrag1 <ButtonPress-1> {DragSite::_begin_drag press  %W %s %X %Y}
+    bind BwDrag1 <B1-Motion>     {DragSite::_begin_drag motion %W %s %X %Y}
+    bind BwDrag2 <ButtonPress-2> {DragSite::_begin_drag press  %W %s %X %Y}
+    bind BwDrag2 <B2-Motion>     {DragSite::_begin_drag motion %W %s %X %Y}
+    bind BwDrag3 <ButtonPress-3> {DragSite::_begin_drag press  %W %s %X %Y}
+    bind BwDrag3 <B3-Motion>     {DragSite::_begin_drag motion %W %s %X %Y}
+
+    proc use {} {}
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command DragSite::include
+# ------------------------------------------------------------------------------
+proc DragSite::include { class type event } {
+    set dragoptions {
+        {-dragenabled Boolean 0  0}
+        {-draginitcmd String  "" 0}
+        {-dragendcmd  String  "" 0}
+    }
+    lappend dragoptions \
+        [list -dragtype  String $type  0] \
+        [list -dragevent Enum   $event 0 {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::getoption .drag$path -dragevent]
+    set initcmd [Widget::getoption .drag$path -draginitcmd]
+    set endcmd  [Widget::getoption .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 {
+            catch { if { ![string compare $_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 compare $type "BITMAP"] || ![string compare $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
+        tkwait visibility $_topw
+        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]
+    }
+}
+
+

lib/external/bwidget/dropsite.tcl

@@ -0,0 +1,451 @@
+# ------------------------------------------------------------------------------
+#  dropsite.tcl
+#  This file is part of Unifix BWidget Toolkit
+#  $Id$
+# ------------------------------------------------------------------------------
+#  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::declare DropSite {
+        {-dropovercmd String "" 0}
+        {-dropcmd     String "" 0}
+        {-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 $env(BWIDGET_LIBRARY) "images" "opcopy.xbm"] \
+             move,img  @[file join $env(BWIDGET_LIBRARY) "images" "opmove.xbm"] \
+             link,img  @[file join $env(BWIDGET_LIBRARY) "images" "oplink.xbm"]]
+
+    bind DragTop <KeyPress-Shift_L>     {DropSite::_update_operation [expr %s | 1]}
+    bind DragTop <KeyPress-Shift_R>     {DropSite::_update_operation [expr %s | 1]}
+    bind DragTop <KeyPress-Control_L>   {DropSite::_update_operation [expr %s | 4]}
+    bind DragTop <KeyPress-Control_R>   {DropSite::_update_operation [expr %s | 4]}
+    if { $tcl_platform(platform) == "unix" } {
+        bind DragTop <KeyPress-Alt_L>       {DropSite::_update_operation [expr %s | 8]}
+        bind DragTop <KeyPress-Alt_R>       {DropSite::_update_operation [expr %s | 8]}
+    } else {
+        bind DragTop <KeyPress-Alt_L>       {DropSite::_update_operation [expr %s | 16]}
+        bind DragTop <KeyPress-Alt_R>       {DropSite::_update_operation [expr %s | 16]}
+    }
+
+    bind DragTop <KeyRelease-Shift_L>   {DropSite::_update_operation [expr %s & ~1]}
+    bind DragTop <KeyRelease-Shift_R>   {DropSite::_update_operation [expr %s & ~1]}
+    bind DragTop <KeyRelease-Control_L> {DropSite::_update_operation [expr %s & ~4]}
+    bind DragTop <KeyRelease-Control_R> {DropSite::_update_operation [expr %s & ~4]}
+    if { $tcl_platform(platform) == "unix" } {
+        bind DragTop <KeyRelease-Alt_L>     {DropSite::_update_operation [expr %s & ~8]}
+        bind DragTop <KeyRelease-Alt_R>     {DropSite::_update_operation [expr %s & ~8]}
+    } else {
+        bind DragTop <KeyRelease-Alt_L>     {DropSite::_update_operation [expr %s & ~16]}
+        bind DragTop <KeyRelease-Alt_R>     {DropSite::_update_operation [expr %s & ~16]}
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command DropSite::include
+# ------------------------------------------------------------------------------
+proc DropSite::include { class types } {
+    set dropoptions {
+        {-dropenabled Boolean 0  0}
+        {-dropovercmd String  "" 0}
+        {-dropcmd     String  "" 0}
+    }
+    lappend dropoptions [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::getoption .drop$path -dropcmd]
+    set types   [Widget::getoption .drop$path -droptypes]
+    set overcmd [Widget::getoption .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 compare $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 compare $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 compare $subop "default"] == 0) } {
+                        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
+
+    catch {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 <ButtonRelease-$evt> {DropSite::_release %X %Y}
+    bind $top <B$evt-Motion>       {DropSite::_motion  %X %Y}
+    bind $top <Motion>             {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 compare $_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 <B$_evt-Motion>]
+    bind $_top <B$_evt-Motion> {}
+    bind $_top <Motion>        {}
+    wm geometry $_top "+[expr {$X+1}]+[expr {$Y+1}]"
+    update
+    if { ![winfo exists $_top] } {
+        return
+    }
+    set path [winfo containing $X $Y]
+    if { [string compare $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 <B$_evt-Motion> {DropSite::_motion  %X %Y}
+                bind $_top <Motion>        {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 <B$_evt-Motion> {DropSite::_motion  %X %Y}
+        bind $_top <Motion>        {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
+    }
+}

lib/external/bwidget/dynhelp.tcl

@@ -0,0 +1,332 @@
+# ------------------------------------------------------------------------------
+#  dynhelp.tcl
+#  This file is part of Unifix BWidget Toolkit
+#  $Id$
+# ------------------------------------------------------------------------------
+#  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
+# ------------------------------------------------------------------------------
+
+namespace eval DynamicHelp {
+    Widget::declare DynamicHelp {
+        {-foreground  TkResource black         0 label}
+        {-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 {=100 =2000}}
+        {-bd          Synonym    -borderwidth}
+        {-bg          Synonym    -background}
+        {-fg          Synonym    -foreground}
+    }
+
+    proc use {} {}
+
+    variable _registered
+
+    variable _top     ".help_shell"
+    variable _id      "" 
+    variable _delay   600
+    variable _current ""
+    variable _saved
+
+    Widget::init DynamicHelp $_top {}
+
+    bind BwHelpBalloon <Enter>   {DynamicHelp::_motion_balloon enter  %W %X %Y}
+    bind BwHelpBalloon <Motion>  {DynamicHelp::_motion_balloon motion %W %X %Y}
+    bind BwHelpBalloon <Leave>   {DynamicHelp::_motion_balloon leave  %W %X %Y}
+    bind BwHelpBalloon <Button>  {DynamicHelp::_motion_balloon button %W %X %Y}
+    bind BwHelpBalloon <Destroy> {catch {unset DynamicHelp::_registered(%W)}}
+
+    bind BwHelpVariable <Enter>   {DynamicHelp::_motion_info %W}
+    bind BwHelpVariable <Motion>  {DynamicHelp::_motion_info %W}
+    bind BwHelpVariable <Leave>   {DynamicHelp::_leave_info  %W}
+    bind BwHelpVariable <Destroy> {catch {unset DynamicHelp::_registered(%W)}}
+
+    bind BwHelpMenu <<MenuSelect>> {DynamicHelp::_menu_info select %W}
+    bind BwHelpMenu <Unmap>        {DynamicHelp::_menu_info unmap  %W}
+    bind BwHelpMenu <Destroy>      {catch {unset DynamicHelp::_registered(%W)}}
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command DynamicHelp::configure
+# ------------------------------------------------------------------------------
+proc DynamicHelp::configure { args } {
+    variable _top
+    variable _delay
+
+    set res [Widget::configure $_top $args]
+    if { [Widget::hasChanged $_top -delay val] } {
+        set _delay $val
+    }
+
+    return $res
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command DynamicHelp::include
+# ------------------------------------------------------------------------------
+proc DynamicHelp::include { class type } {
+    set helpoptions {
+        {-helptext String "" 0}
+        {-helpvar  String "" 0}}
+    lappend helpoptions [list -helptype Enum $type 0 {balloon variable}]
+    Widget::declare $class $helpoptions
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command DynamicHelp::sethelp
+# ------------------------------------------------------------------------------
+proc DynamicHelp::sethelp { path subpath {force 0}} {
+    set ctype [Widget::hasChanged $path -helptype htype]
+    set ctext [Widget::hasChanged $path -helptext htext]
+    set cvar  [Widget::hasChanged $path -helpvar  hvar]
+    if { $force || $ctype || $ctext || $cvar } {
+        switch $htype {
+            balloon {
+                return [register $subpath balloon $htext]
+            }
+            variable {
+                return [register $subpath variable $hvar $htext]
+            }
+        }
+        return [register $subpath $htype]
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command DynamicHelp::register
+# ------------------------------------------------------------------------------
+proc DynamicHelp::register { path type args } {
+    variable _registered
+
+    if { [winfo exists $path] } {
+        set evt  [bindtags $path]
+        set idx  [lsearch $evt "BwHelp*"]
+        set evt  [lreplace $evt $idx $idx]
+        switch $type {
+            balloon {
+                set text [lindex $args 0]
+                if { $text != "" } {
+                    set _registered($path) $text
+                    lappend evt BwHelpBalloon
+                } else {
+                    catch {unset _registered($path)}
+                }
+                bindtags $path $evt
+                return 1
+            }
+
+            variable {
+                set var  [lindex $args 0]
+                set text [lindex $args 1]
+                if { $text != "" && $var != "" } {
+                    set _registered($path) [list $var $text]
+                    lappend evt BwHelpVariable
+                } else {
+                    catch {unset _registered($path)}
+                }
+                bindtags $path $evt
+                return 1
+            }
+
+            menu {
+                set cpath [BWidget::clonename $path]
+                if { [winfo exists $cpath] } {
+                    set path $cpath
+                }
+                set var [lindex $args 0]
+                if { $var != "" } {
+                    set _registered($path) [list $var]
+                    lappend evt BwHelpMenu
+                } else {
+                    catch {unset _registered($path)}
+                }
+                bindtags $path $evt
+                return 1
+            }
+
+            menuentry {
+                set cpath [BWidget::clonename $path]
+                if { [winfo exists $cpath] } {
+                    set path $cpath
+                }
+                if { [info exists _registered($path)] } {
+                    if { [set index [lindex $args 0]] != "" } {
+                        set text  [lindex $args 1]
+                        set idx   [lsearch $_registered($path) [list $index *]]
+                        if { $text != "" } {
+                            if { $idx == -1 } {
+                                lappend _registered($path) [list $index $text]
+                            } else {
+                                set _registered($path) [lreplace $_registered($path) $idx $idx [list $index $text]]
+                            }
+                        } else {
+                            set _registered($path) [lreplace $_registered($path) $idx $idx]
+                        }
+                    }
+                    return 1
+                }
+                return 0
+            }
+        }
+        catch {unset _registered($path)}
+        bindtags $path $evt
+        return 1
+    } else {
+        catch {unset _registered($path)}
+        return 0
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command DynamicHelp::_motion_balloon
+# ------------------------------------------------------------------------------
+proc DynamicHelp::_motion_balloon { type path x y } {
+    variable _top
+    variable _id
+    variable _delay
+    variable _current
+
+    if { $_current != $path && $type == "enter" } {
+        set _current $path
+        set type "motion"
+        destroy $_top
+    }
+    if { $_current == $path } {
+        if { $_id != "" } {
+            after cancel $_id
+            set _id ""
+        }
+        if { $type == "motion" } {
+            if { ![winfo exists $_top] } {
+                set _id [after $_delay "DynamicHelp::_show_help $path $x $y"]
+            }
+        } else {
+            destroy $_top
+            set _current ""
+        }
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command DynamicHelp::_motion_info
+# ------------------------------------------------------------------------------
+proc DynamicHelp::_motion_info { path } {
+    variable _registered
+    variable _current
+    variable _saved
+
+    if { $_current != $path && [info exists _registered($path)] } {
+        if { ![info exists _saved] } {
+            set _saved [GlobalVar::getvar [lindex $_registered($path) 0]]
+        }
+        GlobalVar::setvar [lindex $_registered($path) 0] [lindex $_registered($path) 1]
+        set _current $path
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command DynamicHelp::_leave_info
+# ------------------------------------------------------------------------------
+proc DynamicHelp::_leave_info { path } {
+    variable _registered
+    variable _current
+    variable _saved
+
+    if { [info exists _registered($path)] } {
+        GlobalVar::setvar [lindex $_registered($path) 0] $_saved
+    }
+    unset _saved
+    set _current ""
+    
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command DynamicHelp::_menu_info
+#    Version of R1v1 restored, due to lack of [winfo ismapped] and <Unmap>
+#    under windows for menu.
+# ------------------------------------------------------------------------------
+proc DynamicHelp::_menu_info { event path } {
+    variable _registered
+ 
+    if { [info exists _registered($path)] } {
+        set index [$path index active]
+        if { [string compare $index "none"] &&
+             [set idx [lsearch $_registered($path) [list $index *]]] != -1 } {
+            GlobalVar::setvar [lindex $_registered($path) 0] \
+                [lindex [lindex $_registered($path) $idx] 1]
+        } else {
+            GlobalVar::setvar [lindex $_registered($path) 0] ""
+        }
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command DynamicHelp::_show_help
+# ------------------------------------------------------------------------------
+proc DynamicHelp::_show_help { path x y } {
+    variable _top
+    variable _registered
+    variable _id
+    variable _delay
+
+    if { [info exists _registered($path)] } {
+        destroy  $_top
+        toplevel $_top -relief flat \
+            -bg [Widget::getoption $_top -foreground] \
+            -bd [Widget::getoption $_top -borderwidth]
+        wm overrideredirect $_top 1
+        wm transient $_top
+        wm withdraw $_top
+
+        label $_top.label -text $_registered($path) \
+            -relief flat -bd 0 -highlightthickness 0 \
+            -foreground [Widget::getoption $_top -foreground] \
+            -background [Widget::getoption $_top -background] \
+            -font       [Widget::getoption $_top -font] \
+            -justify    [Widget::getoption $_top -justify]
+
+
+        pack $_top.label -side left
+        update idletasks
+
+        set  scrwidth  [winfo vrootwidth  .]
+        set  scrheight [winfo vrootheight .]
+        set  width     [winfo reqwidth  $_top]
+        set  height    [winfo reqheight $_top]
+        incr y 12
+        incr x 8
+
+        if { $x+$width > $scrwidth } {
+            set x [expr $scrwidth - $width]
+        }
+        if { $y+$height > $scrheight } {
+            set y [expr $y - 12 - $height]
+        }
+
+        wm geometry  $_top "+$x+$y"
+        update idletasks
+        wm deiconify $_top
+    }
+}
+
+

lib/external/bwidget/entry.tcl

@@ -0,0 +1,426 @@
+# ------------------------------------------------------------------------------
+#  entry.tcl
+#  This file is part of Unifix BWidget Toolkit
+#  $Id$
+# ------------------------------------------------------------------------------
+#  Index of commands:
+#     - Entry::create
+#     - Entry::configure
+#     - Entry::cget
+#     - Entry::_destroy
+#     - Entry::_init_drag_cmd
+#     - Entry::_end_drag_cmd
+#     - Entry::_drop_cmd
+#     - Entry::_over_cmd
+#     - Entry::_auto_scroll
+#     - Entry::_scroll
+# ------------------------------------------------------------------------------
+
+namespace eval Entry {
+    Widget::tkinclude Entry entry :cmd \
+        remove {-state -cursor -foreground -textvariable}
+
+    Widget::declare Entry {
+        {-foreground         TkResource ""     0 entry}
+        {-disabledforeground TkResource ""     0 button}
+        {-state              Enum       normal 0 {normal disabled}}
+        {-text               String     "" 0}
+        {-textvariable       String     "" 0}
+        {-editable           Boolean    1  0}
+        {-command            String     "" 0}
+        {-relief             TkResource "" 0 entry}
+        {-borderwidth        TkResource "" 0 entry}
+        {-fg                 Synonym -foreground}
+        {-bd                 Synonym -borderwidth}
+    }
+
+    DynamicHelp::include Entry balloon
+    DragSite::include    Entry "" 3
+    DropSite::include    Entry {
+        TEXT    {move {}}
+        FGCOLOR {move {}}
+        BGCOLOR {move {}}
+        COLOR   {move {}}
+    }
+
+    foreach event [bind Entry] {
+        bind BwEntry $event [bind Entry $event]
+    }
+    bind BwEntry <Return>  {Entry::invoke %W}
+    bind BwEntry <Destroy> {Entry::_destroy %W}
+    bind BwDisabledEntry <Destroy> {Entry::_destroy %W}
+
+    proc ::Entry { path args } { return [eval Entry::create $path $args] }
+    proc use {} {}
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Entry::create
+# ------------------------------------------------------------------------------
+proc Entry::create { path args } {
+    variable $path
+    upvar 0  $path data
+
+    Widget::init Entry $path $args
+
+    set data(afterid) ""
+    if { [set varname [Widget::getoption $path -textvariable]] != "" } {
+        set data(varname) $varname
+    } else {
+        set data(varname) Entry::$path\(var\)
+    }
+
+    if { [GlobalVar::exists $data(varname)] } {
+        set curval [GlobalVar::getvar $data(varname)]
+        Widget::setoption $path -text $curval
+    } else {
+        set curval [Widget::getoption $path -text]
+        GlobalVar::setvar $data(varname) $curval
+    }
+
+    eval entry $path [Widget::subcget $path :cmd]
+    uplevel \#0 $path configure -textvariable [list $data(varname)]
+
+    set state    [Widget::getoption $path -state]
+    set editable [Widget::getoption $path -editable]
+    if { $editable && ![string compare $state "normal"] } {
+        bindtags $path [list $path BwEntry [winfo toplevel $path] all]
+        $path configure -takefocus 1
+    } else {
+        bindtags $path [list $path BwDisabledEntry [winfo toplevel $path] all]
+        $path configure -takefocus 0
+    }
+    if { $editable == 0 } {
+        $path configure -cursor left_ptr
+    }
+    if { ![string compare $state "disabled"] } {
+        $path configure -foreground [Widget::getoption $path -disabledforeground]
+    }
+
+    DragSite::setdrag $path $path Entry::_init_drag_cmd Entry::_end_drag_cmd 1
+    DropSite::setdrop $path $path Entry::_over_cmd Entry::_drop_cmd 1
+    DynamicHelp::sethelp $path $path 1
+
+    rename $path ::$path:cmd
+    proc ::$path { cmd args } "return \[Entry::_path_command $path \$cmd \$args\]"
+
+    return $path
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Entry::configure
+# ------------------------------------------------------------------------------
+proc Entry::configure { path args } {
+    variable $path
+    upvar 0  $path data
+
+    Widget::setoption $path -text [$path:cmd get]
+
+    set res [Widget::configure $path $args]
+
+    set chstate    [Widget::hasChanged $path -state state]
+    set cheditable [Widget::hasChanged $path -editable editable]
+    set chfg       [Widget::hasChanged $path -foreground fg]
+    set chdfg      [Widget::hasChanged $path -disabledforeground dfg]
+
+    if { $chstate || $cheditable } {
+        set btags [bindtags $path]
+        if { $editable && ![string compare $state "normal"] } {
+            set idx [lsearch $btags BwDisabledEntry]
+            if { $idx != -1 } {
+                bindtags $path [lreplace $btags $idx $idx BwEntry]
+            }
+            $path:cmd configure -takefocus 1
+        } else {
+            set idx [lsearch $btags BwEntry]
+            if { $idx != -1 } {
+                bindtags $path [lreplace $btags $idx $idx BwDisabledEntry]
+            }
+            $path:cmd configure -takefocus 0
+            if { ![string compare [focus] $path] } {
+                focus .
+            }
+        }
+    }
+
+    if { $chstate || $chfg || $chdfg } {
+        if { ![string compare $state "disabled"] } {
+            $path:cmd configure -fg $dfg
+        } else {
+            $path:cmd configure -fg $fg
+        }
+    }
+
+    if { $cheditable } {
+        if { $editable } {
+            $path:cmd configure -cursor xterm
+        } else {
+            $path:cmd configure -cursor left_ptr
+        }
+    }
+
+    if { [Widget::hasChanged $path -textvariable varname] } {
+        if { [string length $varname] } {
+            set data(varname) $varname
+        } else {
+            catch {unset data(var)}
+            set data(varname) Entry::$path\(var\)
+        }
+        if { [GlobalVar::exists $data(varname)] } {
+            set curval [GlobalVar::getvar $data(varname)]
+            Widget::setoption $path -text $curval
+        } else {
+            Widget::hasChanged $path -text curval
+            GlobalVar::setvar $data(varname) $curval
+        }
+        uplevel \#0 $path:cmd configure -textvariable [list $data(varname)]
+    }
+
+    if { [Widget::hasChanged $path -text curval] } {
+        if { [Widget::getoption $path -textvariable] == "" } {
+            GlobalVar::setvar $data(varname) $curval
+        } else {
+            Widget::setoption $path -text [GlobalVar::getvar $data(varname)]
+        }
+    }
+
+    DragSite::setdrag $path $path Entry::_init_drag_cmd Entry::_end_drag_cmd
+    DropSite::setdrop $path $path Entry::_over_cmd Entry::_drop_cmd
+    DynamicHelp::sethelp $path $path
+
+    return $res
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Entry::cget
+# ------------------------------------------------------------------------------
+proc Entry::cget { path option } {
+    Widget::setoption $path -text [$path:cmd get]
+    return [Widget::cget $path $option]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Entry::invoke
+# ------------------------------------------------------------------------------
+proc Entry::invoke { path } {
+    if { [set cmd [Widget::getoption $path -command]] != "" } {
+        uplevel \#0 $cmd
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Entry::_path_command
+# ------------------------------------------------------------------------------
+proc Entry::_path_command { path cmd larg } {
+    if { ![string compare $cmd "configure"] || ![string compare $cmd "cget"] } {
+        return [eval Entry::$cmd $path $larg]
+    } else {
+        return [eval $path:cmd $cmd $larg]
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Entry::_destroy
+# ------------------------------------------------------------------------------
+proc Entry::_destroy { path } {
+    variable $path
+    upvar 0  $path data
+
+    Widget::destroy $path
+    rename $path {}
+    unset data
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Entry::_init_drag_cmd
+# ------------------------------------------------------------------------------
+proc Entry::_init_drag_cmd { path X Y top } {
+    variable $path
+    upvar 0  $path data
+
+    if { [set cmd [Widget::getoption $path -draginitcmd]] != "" } {
+        return [uplevel \#0 $cmd [list $path $X $Y $top]]
+    }
+    set type [Widget::getoption $path -dragtype]
+    if { $type == "" } {
+        set type "TEXT"
+    }
+    if { [set drag [$path get]] != "" } {
+        if { [$path:cmd selection present] } {
+            set idx  [$path:cmd index @[expr $X-[winfo rootx $path]]]
+            set sel0 [$path:cmd index sel.first]
+            set sel1 [expr [$path:cmd index sel.last]-1]
+            if { $idx >=  $sel0 && $idx <= $sel1 } {
+                set drag [string range $drag $sel0 $sel1]
+                set data(dragstart) $sel0
+                set data(dragend)   [expr {$sel1+1}]
+                if { ![Widget::getoption $path -editable] ||
+                     [Widget::getoption $path -state] == "disabled" } {
+                    return [list $type {copy} $drag]
+                } else {
+                    return [list $type {copy move} $drag]
+                }
+            }
+        } else {
+            set data(dragstart) 0
+            set data(dragend)   end
+            if { ![Widget::getoption $path -editable] ||
+                 [Widget::getoption $path -state] == "disabled" } {
+                return [list $type {copy} $drag]
+            } else {
+                return [list $type {copy move} $drag]
+            }
+        }
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Entry::_end_drag_cmd
+# ------------------------------------------------------------------------------
+proc Entry::_end_drag_cmd { path target op type dnddata result } {
+    variable $path
+    upvar 0  $path data
+
+    if { [set cmd [Widget::getoption $path -dragendcmd]] != "" } {
+        return [uplevel \#0 $cmd [list $path $target $op $type $dnddata $result]]
+    }
+    if { $result && $op == "move" && $path != $target } {
+        $path:cmd delete $data(dragstart) $data(dragend)
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Entry::_drop_cmd
+# ------------------------------------------------------------------------------
+proc Entry::_drop_cmd { path source X Y op type dnddata } {
+    variable $path
+    upvar 0  $path data
+
+    if { $data(afterid) != "" } {
+        after cancel $data(afterid)
+        set data(afterid) ""
+    }
+    if { [set cmd [Widget::getoption $path -dropcmd]] != "" } {
+        set idx [$path:cmd index @[expr $X-[winfo rootx $path]]]
+        return [uplevel \#0 $cmd [list $path $source $idx $op $type $dnddata]]
+    }
+    if { $type == "COLOR" || $type == "FGCOLOR" } {
+        configure $path -foreground $dnddata
+    } elseif { $type == "BGCOLOR" } {
+        configure $path -background $dnddata
+    } else {
+        $path:cmd icursor @[expr $X-[winfo rootx $path]]
+        if { $op == "move" && $path == $source } {
+            $path:cmd delete $data(dragstart) $data(dragend)
+        }
+        set sel0 [$path index insert]
+        $path:cmd insert insert $dnddata
+        set sel1 [$path index insert]
+        $path:cmd selection range $sel0 $sel1
+    }
+    return 1
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Entry::_over_cmd
+# ------------------------------------------------------------------------------
+proc Entry::_over_cmd { path source event X Y op type dnddata } {
+    variable $path
+    upvar 0  $path data
+
+    set x [expr $X-[winfo rootx $path]]
+    if { ![string compare $event "leave"] } {
+        if { [string length $data(afterid)] } {
+            after cancel $data(afterid)
+            set data(afterid) ""
+        }
+    } elseif { [_auto_scroll $path $x] } {
+        return 2
+    }
+
+    if { [set cmd [Widget::getoption $path -dropovercmd]] != "" } {
+        set x   [expr $X-[winfo rootx $path]]
+        set idx [$path:cmd index @$x]
+        set res [uplevel \#0 $cmd [list $path $source $event $idx $op $type $dnddata]]
+        return $res
+    }
+
+    if { ![string compare $type "COLOR"]   ||
+         ![string compare $type "FGCOLOR"] ||
+         ![string compare $type "BGCOLOR"] } {
+        DropSite::setcursor based_arrow_down
+        return 1
+    }
+    if { [Widget::getoption $path -editable] && ![string compare [Widget::getoption $path -state] "normal"] } {
+        if { [string compare $event "leave"] } {
+            $path:cmd selection clear
+            $path:cmd icursor @$x
+            DropSite::setcursor based_arrow_down
+            return 3
+        }
+    }
+    DropSite::setcursor dot
+    return 0
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Entry::_auto_scroll
+# ------------------------------------------------------------------------------
+proc Entry::_auto_scroll { path x } {
+    variable $path
+    upvar 0  $path data
+
+    set xmax [winfo width $path]
+    if { $x <= 10 && [$path:cmd index @0] > 0 } {
+        if { $data(afterid) == "" } {
+            set data(afterid) [after 100 "Entry::_scroll $path -1 $x $xmax"]
+            DropSite::setcursor sb_left_arrow
+        }
+        return 1
+    } else {
+        if { $x >= $xmax-10 && [$path:cmd index @$xmax] < [$path:cmd index end] } {
+            if { $data(afterid) == "" } {
+                set data(afterid) [after 100 "Entry::_scroll $path 1 $x $xmax"]
+                DropSite::setcursor sb_right_arrow
+            }
+            return 1
+        } else {
+            if { $data(afterid) != "" } {
+                after cancel $data(afterid)
+                set data(afterid) ""
+            }
+        }
+    }
+    return 0
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Entry::_scroll
+# ------------------------------------------------------------------------------
+proc Entry::_scroll { path dir x xmax } {
+    variable $path
+    upvar 0  $path data
+
+    $path:cmd xview scroll $dir units
+    $path:cmd icursor @$x
+    if { ($dir == -1 && [$path:cmd index @0] > 0) ||
+         ($dir == 1  && [$path:cmd index @$xmax] < [$path:cmd index end]) } {
+        set data(afterid) [after 100 "Entry::_scroll $path $dir $x $xmax"]
+    } else {
+        set data(afterid) ""
+        DropSite::setcursor dot
+    }
+}
+

lib/external/bwidget/font.tcl

@@ -0,0 +1,379 @@
+# ------------------------------------------------------------------------------
+#  font.tcl
+#  This file is part of Unifix BWidget Toolkit
+# ------------------------------------------------------------------------------
+#  Index of commands:
+#     - SelectFont::create
+#     - SelectFont::configure
+#     - SelectFont::cget
+#     - SelectFont::_draw
+#     - SelectFont::_destroy
+#     - SelectFont::_modstyle
+#     - SelectFont::_update
+#     - SelectFont::_getfont
+#     - SelectFont::_init
+# ------------------------------------------------------------------------------
+
+namespace eval SelectFont {
+    Dialog::use
+    LabelFrame::use
+    ScrolledWindow::use
+
+    Widget::declare SelectFont {
+        {-title      String     "Font selection" 0}
+        {-parent     String     "" 0}
+        {-background TkResource "" 0 frame}
+
+        {-type       Enum       dialog        0 {dialog toolbar}}
+        {-font       TkResource ""            0 label}
+        {-command    String     ""            0}
+        {-sampletext String     "Sample Text" 0}
+        {-bg         Synonym    -background}
+    }
+
+    proc ::SelectFont { path args } { return [eval SelectFont::create $path $args] }
+    proc use {} {}
+
+    variable _families
+    variable _styles   {bold italic underline overstrike}
+    variable _sizes    {4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24}
+
+    variable _widget
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command SelectFont::create
+# ------------------------------------------------------------------------------
+proc SelectFont::create { path args } {
+    variable _families
+    variable _sizes
+    variable _styles
+    variable $path
+    upvar 0  $path data
+
+    if { ![info exists _families] } {
+        loadfont
+    }
+    Widget::init SelectFont "$path#SelectFont" $args
+    set bg [Widget::getoption "$path#SelectFont" -background]
+    if { [Widget::getoption "$path#SelectFont" -type] == "dialog" } {
+        Dialog::create $path -modal local -default 0 -cancel 1 -background $bg \
+            -title  [Widget::getoption "$path#SelectFont" -title] \
+            -parent [Widget::getoption "$path#SelectFont" -parent]
+
+        set frame [Dialog::getframe $path]
+        set topf  [frame $frame.topf -relief flat -borderwidth 0 -background $bg]
+
+        set labf1 [LabelFrame::create $topf.labf1 -text "Font" -name font \
+                       -side top -anchor w -relief flat -background $bg]
+        set sw    [ScrolledWindow::create [LabelFrame::getframe $labf1].sw \
+                       -background $bg]
+        set lbf   [listbox $sw.lb \
+                       -height 5 -width 25 -exportselection false -selectmode browse]
+        ScrolledWindow::setwidget $sw $lbf
+        LabelFrame::configure $labf1 -focus $lbf
+        eval $lbf insert end $_families
+        set script "set SelectFont::$path\(family\) \[%W curselection\]; SelectFont::_update $path"
+        bind $lbf <ButtonRelease-1> $script
+        bind $lbf <space>           $script
+        pack $sw -fill both -expand yes
+
+        set labf2 [LabelFrame::create $topf.labf2 -text "Size" -name size \
+                       -side top -anchor w -relief flat -background $bg]
+        set sw    [ScrolledWindow::create [LabelFrame::getframe $labf2].sw \
+                       -scrollbar vertical -background $bg]
+        set lbs   [listbox $sw.lb \
+                       -height 5 -width 6 -exportselection false -selectmode browse]
+        ScrolledWindow::setwidget $sw $lbs
+        LabelFrame::configure $labf2 -focus $lbs
+        eval $lbs insert end $_sizes
+        set script "set SelectFont::$path\(size\) \[%W curselection\]; SelectFont::_update $path"
+        bind $lbs <ButtonRelease-1> $script
+        bind $lbs <space>           $script
+        pack $sw -fill both -expand yes
+
+        set labf3 [LabelFrame::create $topf.labf3 -text "Style" -name style \
+                       -side top -anchor w -relief sunken -bd 1 -background $bg]
+        set subf  [LabelFrame::getframe $labf3]
+        foreach st $_styles {
+            set name [lindex [BWidget::getname $st] 0]
+            if { $name == "" } {
+                set name "[string toupper [string index $name 0]][string range $name 1 end]"
+            }
+            checkbutton $subf.$st -text $name \
+                -variable   SelectFont::$path\($st\) \
+                -background $bg \
+                -command    "SelectFont::_update $path"
+            bind $subf.$st <Return> break
+            pack $subf.$st -anchor w
+        }
+        LabelFrame::configure $labf3 -focus $subf.[lindex $_styles 0]
+
+        pack $labf1 -side left -anchor n -fill both -expand yes
+        pack $labf2 -side left -anchor n -fill both -expand yes -padx 8
+        pack $labf3 -side left -anchor n -fill both -expand yes
+
+        set botf [frame $frame.botf -width 100 -height 50 \
+                      -bg white -bd 0 -relief flat \
+                      -highlightthickness 1 -takefocus 0 \
+                      -highlightbackground black \
+                      -highlightcolor black]
+
+        set lab  [label $botf.label \
+                      -background white -foreground black \
+                      -borderwidth 0 -takefocus 0 -highlightthickness 0 \
+                      -text [Widget::getoption "$path#SelectFont" -sampletext]]
+        place $lab -relx 0.5 -rely 0.5 -anchor c
+
+        pack $topf -pady 4 -fill both -expand yes
+        pack $botf -pady 4 -fill x
+
+        Dialog::add $path -name ok
+        Dialog::add $path -name cancel
+
+        set data(label) $lab
+        set data(lbf)   $lbf
+        set data(lbs)   $lbs
+
+        _getfont $path
+
+        proc ::$path { cmd args } "return \[eval SelectFont::\$cmd $path \$args\]"
+
+        return [_draw $path]
+    } else {
+        frame $path -relief flat -borderwidth 0 -background $bg
+        bind $path <Destroy> "SelectFont::_destroy $path"
+        set lbf [ComboBox::create $path.font \
+                     -highlightthickness 0 -takefocus 0 -background $bg \
+                     -values   $_families \
+                     -textvariable SelectFont::$path\(family\) \
+                     -editable 0 \
+                     -modifycmd "SelectFont::_update $path"]
+        set lbs [ComboBox::create $path.size \
+                     -highlightthickness 0 -takefocus 0 -background $bg \
+                     -width    4 \
+                     -values   $_sizes \
+                     -textvariable SelectFont::$path\(size\) \
+                     -editable 0 \
+                     -modifycmd "SelectFont::_update $path"]
+        pack $lbf -side left -anchor w
+        pack $lbs -side left -anchor w -padx 4
+        foreach st $_styles {
+            button $path.$st \
+                -highlightthickness 0 -takefocus 0 -padx 0 -pady 0 -bd 2 \
+                -background $bg \
+                -image  [Bitmap::get $st] \
+                -command "SelectFont::_modstyle $path $st"
+            pack $path.$st -side left -anchor w
+        }
+        set data(label) ""
+        set data(lbf)   $lbf
+        set data(lbs)   $lbs
+        _getfont $path
+
+        rename $path ::$path:cmd
+        proc ::$path { cmd args } "return \[eval SelectFont::\$cmd $path \$args\]"
+    }
+
+    return $path
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command SelectFont::configure
+# ------------------------------------------------------------------------------
+proc SelectFont::configure { path args } {
+    variable _styles
+
+    set res [Widget::configure "$path#SelectFont" $args]
+
+    if { [Widget::hasChanged "$path#SelectFont" -font font] } {
+        _getfont $path
+    }
+    if { [Widget::hasChanged "$path#SelectFont" -background bg] } {
+        switch -- [Widget::getoption "$path#SelectFont" -type] {
+            dialog {
+                Dialog::configure $path -background $bg
+                set topf [Dialog::getframe $path].topf
+                $topf configure -background $bg
+                foreach labf {labf1 labf2} {
+                    LabelFrame::configure $topf.$labf -background $bg
+                    set subf [LabelFrame::getframe $topf.$labf]
+                    ScrolledWindow::configure $subf.sw -background $bg
+                    $subf.sw.lb configure -background $bg
+                }
+                LabelFrame::configure $topf.labf3 -background $bg
+                set subf [LabelFrame::getframe $topf.labf3]
+                foreach w [winfo children $subf] {
+                    $w configure -background $bg
+                }
+            }
+            toolbar {
+                $path configure -background $bg
+                ComboBox::configure $path.font -background $bg
+                ComboBox::configure $path.size -background $bg
+                foreach st $_styles {
+                    $path.$st configure -background $bg
+                }
+            }
+        }
+    }
+    return $res
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command SelectFont::cget
+# ------------------------------------------------------------------------------
+proc SelectFont::cget { path option } {
+    return [Widget::cget "$path#SelectFont" $option]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command SelectFont::loadfont
+# ------------------------------------------------------------------------------
+proc SelectFont::loadfont { } {
+    variable _families
+
+    # initialize families
+    set _families {}
+    set lfont     [font families]
+    lappend lfont times courier helvetica
+    foreach font $lfont {
+        set family [font actual [list $font] -family]
+        if { [lsearch -exact $_families $family] == -1 } {
+            lappend _families $family
+        }
+    }
+    set _families [lsort $_families]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command SelectFont::_draw
+# ------------------------------------------------------------------------------
+proc SelectFont::_draw { path } {
+    variable $path
+    upvar 0  $path data
+
+    $data(lbf) selection clear 0 end
+    $data(lbf) selection set $data(family)
+    $data(lbf) activate $data(family)
+    $data(lbf) see $data(family)
+    $data(lbs) selection clear 0 end
+    $data(lbs) selection set $data(size)
+    $data(lbs) activate $data(size)
+    $data(lbs) see $data(size)
+    _update $path
+
+    if { [Dialog::draw $path] == 0 } {
+        set result [Widget::getoption "$path#SelectFont" -font]
+    } else {
+        set result ""
+    }
+    unset data
+    Widget::destroy "$path#SelectFont"
+    destroy $path
+    return $result
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command SelectFont::_destroy
+# ------------------------------------------------------------------------------
+proc SelectFont::_destroy { path } {
+    variable $path
+    upvar 0  $path data
+
+    unset data
+    Widget::destroy "$path#SelectFont"
+    rename $path {}
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command SelectFont::_modstyle
+# ------------------------------------------------------------------------------
+proc SelectFont::_modstyle { path style } {
+    variable $path
+    upvar 0  $path data
+
+    if { $data($style) == 1 } {
+        $path.$style configure -relief raised
+        set data($style) 0
+    } else {
+        $path.$style configure -relief sunken
+        set data($style) 1
+    }
+    _update $path
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command SelectFont::_update
+# ------------------------------------------------------------------------------
+proc SelectFont::_update { path } {
+    variable _families
+    variable _sizes
+    variable _styles
+    variable $path
+    upvar 0  $path data
+
+    set type [Widget::getoption "$path#SelectFont" -type]
+    if { $type == "dialog" } {
+        set curs [$path:cmd cget -cursor]
+        $path:cmd configure -cursor watch
+    }
+    if { [Widget::getoption "$path#SelectFont" -type] == "dialog" } {
+        set font [list \
+                      [lindex $_families $data(family)] \
+                      [lindex $_sizes $data(size)]]
+    } else {
+        set font [list $data(family) $data(size)]
+    }
+    foreach st $_styles {
+        if { $data($st) } {
+            lappend font $st
+        }
+    }
+    Widget::setoption "$path#SelectFont" -font $font
+    if { $type == "dialog" } {
+        $data(label) configure -font $font
+        $path:cmd configure -cursor $curs
+    } elseif { [set cmd [Widget::getoption "$path#SelectFont" -command]] != "" } {
+        uplevel \#0 $cmd
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command SelectFont::_getfont
+# ------------------------------------------------------------------------------
+proc SelectFont::_getfont { path } {
+    variable _families
+    variable _styles
+    variable _sizes
+    variable $path
+    upvar 0  $path data
+
+    array set font [font actual [Widget::getoption "$path#SelectFont" -font]]
+    set data(bold)       [expr {[string compare $font(-weight) "normal"] != 0}]
+    set data(italic)     [expr {[string compare $font(-slant)  "roman"]  != 0}]
+    set data(underline)  $font(-underline)
+    set data(overstrike) $font(-overstrike)
+    if { [Widget::getoption "$path#SelectFont" -type] == "dialog" } {
+        set idxf [lsearch $_families $font(-family)]
+        set idxs [lsearch $_sizes    $font(-size)]
+        set data(family) [expr {$idxf >= 0 ? $idxf : 0}]
+        set data(size)   [expr {$idxs >= 0 ? $idxs : 0}]
+    } else {
+        set data(family) $font(-family)
+        set data(size)   $font(-size)
+        foreach st $_styles {
+            $path.$st configure -relief [expr {$data($st) ? "sunken":"raised"}]
+        }
+    }
+}
+

lib/external/bwidget/images/minus.xbm

@@ -0,0 +1,5 @@
+#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};

lib/external/bwidget/images/opcopy.xbm

@@ -0,0 +1,5 @@
+#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};

lib/external/bwidget/images/oplink.xbm

@@ -0,0 +1,5 @@
+#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};

lib/external/bwidget/images/opmove.xbm

@@ -0,0 +1,5 @@
+#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};

lib/external/bwidget/images/plus.xbm

@@ -0,0 +1,5 @@
+#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};

lib/external/bwidget/init.tcl

@@ -0,0 +1,21 @@
+
+if { $tcl_platform(platform) == "windows" } {
+    option add *Listbox.background      SystemWindow widgetDefault
+    option add *ListBox.background      SystemWindow widgetDefault
+    option add *Tree.background         SystemWindow widgetDefault
+    option add *Button.padY             0 widgetDefault
+    option add *ButtonBox.padY          0 widgetDefault
+    option add *Dialog.padY             0 widgetDefault
+    option add *Dialog.anchor           e widgetDefault
+} else { 
+    option add *Scrollbar.width         12 widgetDefault
+    option add *Scrollbar.borderWidth   1  widgetDefault
+    option add *Dialog.separator        1  widgetDefault
+    option add *MainFrame.relief        raised widgetDefault
+    option add *MainFrame.separator     none   widgetDefault
+}
+
+option read [file join $env(BWIDGET_LIBRARY) "lang" "en.rc"]
+
+bind all <Key-Tab>       {focus [Widget::focusNext %W]}
+bind all <Shift-Key-Tab> {focus [Widget::focusPrev %W]}

lib/external/bwidget/label.tcl

@@ -0,0 +1,258 @@
+# ------------------------------------------------------------------------------
+#  label.tcl
+#  This file is part of Unifix BWidget Toolkit
+#  $Id$
+# ------------------------------------------------------------------------------
+#  Index of commands:
+#     - Label::create
+#     - Label::configure
+#     - Label::cget
+#     - Label::setfocus
+#     - Label::_drag_cmd
+#     - Label::_drop_cmd
+#     - Label::_over_cmd
+# ------------------------------------------------------------------------------
+
+namespace eval Label {
+    Widget::tkinclude Label label :cmd \
+        remove {-foreground -text -textvariable -underline}
+
+    Widget::declare Label {
+        {-name               String     "" 0}
+        {-text               String     "" 0}
+        {-textvariable       String     "" 0}
+        {-underline          Int        -1 0 {=-1}}
+        {-focus              String     "" 0}
+        {-foreground         TkResource "" 0 label}
+        {-disabledforeground TkResource "" 0 button}
+        {-state              Enum       normal 0  {normal disabled}}
+        {-fg                 Synonym    -foreground}
+
+    }
+    DynamicHelp::include Label balloon
+    DragSite::include    Label "" 1
+    DropSite::include    Label {
+        TEXT    {move {}}
+        IMAGE   {move {}}
+        BITMAP  {move {}}
+        FGCOLOR {move {}}
+        BGCOLOR {move {}}
+        COLOR   {move {}}
+    }
+
+    Widget::syncoptions Label "" :cmd {-text {} -underline {}}
+
+    proc ::Label { path args } { return [eval Label::create $path $args] }
+    proc use {} {}
+
+    bind BwLabel <FocusIn> {Label::setfocus %W}
+    bind BwLabel <Destroy> {Widget::destroy %W; rename %W {}}
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Label::create
+# ------------------------------------------------------------------------------
+proc Label::create { path args } {
+    Widget::init Label $path $args
+
+    if { [Widget::getoption $path -state] == "normal" } {
+        set fg [Widget::getoption $path -foreground]
+    } else {
+        set fg [Widget::getoption $path -disabledforeground]
+    }
+
+    set var [Widget::getoption $path -textvariable]
+    if {  $var == "" &&
+          [Widget::getoption $path -image] == "" &&
+          [Widget::getoption $path -bitmap] == ""} {
+        set desc [BWidget::getname [Widget::getoption $path -name]]
+        if { $desc != "" } {
+            set text  [lindex $desc 0]
+            set under [lindex $desc 1]
+        } else {
+            set text  [Widget::getoption $path -text]
+            set under [Widget::getoption $path -underline]
+        }
+    } else {
+        set under -1
+        set text  ""
+    }
+
+    eval label $path [Widget::subcget $path :cmd] \
+        [list -text $text -textvariable $var -underline $under -foreground $fg]
+
+    set accel [string tolower [string index $text $under]]
+    if { $accel != "" } {
+        bind [winfo toplevel $path] <Alt-$accel> "Label::setfocus $path"
+    }
+
+    bindtags $path [list $path Label BwLabel [winfo toplevel $path] all]
+
+    DragSite::setdrag $path $path Label::_init_drag_cmd [Widget::getoption $path -dragendcmd] 1
+    DropSite::setdrop $path $path Label::_over_cmd Label::_drop_cmd 1
+    DynamicHelp::sethelp $path $path 1
+
+    rename $path ::$path:cmd
+    proc ::$path { cmd args } "return \[eval Label::\$cmd $path \$args\]"
+
+    return $path
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Label::configure
+# ------------------------------------------------------------------------------
+proc Label::configure { path args } {
+    set oldunder [$path:cmd cget -underline]
+    if { $oldunder != -1 } {
+        set oldaccel [string tolower [string index [$path:cmd cget -text] $oldunder]]
+    } else {
+        set oldaccel ""
+    }
+    set res [Widget::configure $path $args]
+
+    set cfg  [Widget::hasChanged $path -foreground fg]
+    set cdfg [Widget::hasChanged $path -disabledforeground dfg]
+    set cst  [Widget::hasChanged $path -state state]
+
+    if { $cst || $cfg || $cdfg } {
+        if { $state == "normal" } {
+            $path:cmd configure -fg $fg
+        } else {
+            $path:cmd configure -fg $dfg
+        }
+    }
+
+    set cv [Widget::hasChanged $path -textvariable var]
+    set cb [Widget::hasChanged $path -image img]
+    set ci [Widget::hasChanged $path -bitmap bmp]
+    set cn [Widget::hasChanged $path -name name]
+    set ct [Widget::hasChanged $path -text text]
+    set cu [Widget::hasChanged $path -underline under]
+
+    if { $cv || $cb || $ci || $cn || $ct || $cu } {
+        if {  $var == "" && $img == "" && $bmp == "" } {
+            set desc [BWidget::getname $name]
+            if { $desc != "" } {
+                set text  [lindex $desc 0]
+                set under [lindex $desc 1]
+            }
+        } else {
+            set under -1
+            set text  ""
+        }
+        set top [winfo toplevel $path]
+        if { $oldaccel != "" } {
+            bind $top <Alt-$oldaccel> {}
+        }
+        set accel [string tolower [string index $text $under]]
+        if { $accel != "" } {
+            bind $top <Alt-$accel> "Label::setfocus $path"
+        }
+        $path:cmd configure -text $text -underline $under -textvariable $var
+    }
+
+    set force [Widget::hasChanged $path -dragendcmd dragend]
+    DragSite::setdrag $path $path Label::_init_drag_cmd $dragend $force
+    DropSite::setdrop $path $path Label::_over_cmd Label::_drop_cmd
+    DynamicHelp::sethelp $path $path
+
+    return $res
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Label::cget
+# ------------------------------------------------------------------------------
+proc Label::cget { path option } {
+    return [Widget::cget $path $option]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Label::setfocus
+# ------------------------------------------------------------------------------
+proc Label::setfocus { path } {
+    if { ![string compare [Widget::getoption $path -state] "normal"] } {
+        set w [Widget::getoption $path -focus]
+        if { [winfo exists $w] && [Widget::focusOK $w] } {
+            focus $w
+        }
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Label::_init_drag_cmd
+# ------------------------------------------------------------------------------
+proc Label::_init_drag_cmd { path X Y top } {
+    if { [set cmd [Widget::getoption $path -draginitcmd]] != "" } {
+        return [uplevel \#0 $cmd [list $path $X $Y $top]]
+    }
+    if { [set data [$path:cmd cget -image]] != "" } {
+        set type "IMAGE"
+        pack [label $top.l -image $data]
+    } elseif { [set data [$path:cmd cget -bitmap]] != "" } {
+        set type "BITMAP"
+        pack [label $top.l -bitmap $data]
+    } else {
+        set data [$path:cmd cget -text]
+        set type "TEXT"
+    }
+    set usertype [Widget::getoption $path -dragtype]
+    if { $usertype != "" } {
+        set type $usertype
+    }
+    return [list $type {copy} $data]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Label::_drop_cmd
+# ------------------------------------------------------------------------------
+proc Label::_drop_cmd { path source X Y op type data } {
+    if { [set cmd [Widget::getoption $path -dropcmd]] != "" } {
+        return [uplevel \#0 $cmd [list $path $source $X $Y $op $type $data]]
+    }
+    if { $type == "COLOR" || $type == "FGCOLOR" } {
+        configure $path -foreground $data
+    } elseif { $type == "BGCOLOR" } {
+        configure $path -background $data
+    } else {
+        set text   ""
+        set image  ""
+        set bitmap ""
+        switch -- $type {
+            IMAGE   {set image $data}
+            BITMAP  {set bitmap $data}
+            default {
+                set text $data
+                if { [set var [$path:cmd cget -textvariable]] != "" } {
+                    configure $path -image "" -bitmap ""
+                    GlobalVar::setvar $var $data
+                    return
+                }
+            }
+        }
+        configure $path -text $text -image $image -bitmap $bitmap
+    }
+    return 1
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Label::_over_cmd
+# ------------------------------------------------------------------------------
+proc Label::_over_cmd { path source event X Y op type data } {
+    if { [set cmd [Widget::getoption $path -dropovercmd]] != "" } {
+        return [uplevel \#0 $cmd [list $path $source $event $X $Y $op $type $data]]
+    }
+    if { [Widget::getoption $path -state] == "normal" ||
+         $type == "COLOR" || $type == "FGCOLOR" || $type == "BGCOLOR" } {
+        DropSite::setcursor based_arrow_down
+        return 1
+    }
+    DropSite::setcursor dot
+    return 0
+}

lib/external/bwidget/labelentry.tcl

@@ -0,0 +1,100 @@
+# ------------------------------------------------------------------------------
+#  labelentry.tcl
+#  This file is part of Unifix BWidget Toolkit
+#  $Id$
+# ------------------------------------------------------------------------------
+#  Index of commands:
+#     - LabelEntry::create
+#     - LabelEntry::configure
+#     - LabelEntry::cget
+#     - LabelEntry::bind
+# ------------------------------------------------------------------------------
+
+namespace eval LabelEntry {
+    Entry::use
+    LabelFrame::use
+
+    Widget::bwinclude LabelEntry LabelFrame .labf \
+        remove {-relief -borderwidth -focus} \
+        rename {-text -label} \
+        prefix {label -justify -width -anchor -height -font} \
+
+    Widget::bwinclude LabelEntry Entry .e \
+        remove {-fg -bg} \
+        rename {-foreground -entryfg -background -entrybg}
+
+    Widget::addmap LabelEntry "" :cmd {-background {}}
+
+    Widget::syncoptions LabelEntry Entry .e {-text {}}
+    Widget::syncoptions LabelEntry LabelFrame .labf {-label -text -underline {}}
+
+    ::bind BwLabelEntry <FocusIn> {focus %W.labf}
+    ::bind BwLabelEntry <Destroy> {Widget::destroy %W; rename %W {}}
+
+    proc ::LabelEntry { path args } { return [eval LabelEntry::create $path $args] }
+    proc use { } {}
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command LabelEntry::create
+# ------------------------------------------------------------------------------
+proc LabelEntry::create { path args } {
+    Widget::init LabelEntry $path $args
+
+    eval frame $path [Widget::subcget $path :cmd] \
+	    -relief flat -bd 0 -highlightthickness 0 -takefocus 0
+	
+    set labf  [eval LabelFrame::create $path.labf [Widget::subcget $path .labf] \
+                   -relief flat -borderwidth 0 -focus $path.e]
+    set subf  [LabelFrame::getframe $labf]
+    set entry [eval Entry::create $path.e [Widget::subcget $path .e]]
+
+    pack $entry -in $subf -fill both -expand yes
+    pack $labf  -fill both -expand yes
+
+    bindtags $path [list $path BwLabelEntry [winfo toplevel $path] all]
+
+    rename $path ::$path:cmd
+    proc ::$path { cmd args } "return \[LabelEntry::_path_command $path \$cmd \$args\]"
+
+    return $path
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command LabelEntry::configure
+# ------------------------------------------------------------------------------
+proc LabelEntry::configure { path args } {
+    return [Widget::configure $path $args]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command LabelEntry::cget
+# ------------------------------------------------------------------------------
+proc LabelEntry::cget { path option } {
+    return [Widget::cget $path $option]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command LabelEntry::bind
+# ------------------------------------------------------------------------------
+proc LabelEntry::bind { path args } {
+    return [eval ::bind $path.e $args]
+}
+
+
+#------------------------------------------------------------------------------
+#  Command LabelEntry::_path_command
+#------------------------------------------------------------------------------
+proc LabelEntry::_path_command { path cmd larg } {
+    if { ![string compare $cmd "configure"] ||
+         ![string compare $cmd "cget"] ||
+         ![string compare $cmd "bind"] } {
+        return [eval LabelEntry::$cmd $path $larg]
+    } else {
+        return [eval $path.e:cmd $cmd $larg]
+    }
+}

lib/external/bwidget/labelframe.tcl

@@ -0,0 +1,160 @@
+# ------------------------------------------------------------------------------
+#  labelframe.tcl
+#  This file is part of Unifix BWidget Toolkit
+#  $Id$
+# ------------------------------------------------------------------------------
+#  Index of commands:
+#     - LabelFrame::create
+#     - LabelFrame::getframe
+#     - LabelFrame::configure
+#     - LabelFrame::cget
+#     - LabelFrame::align
+# ------------------------------------------------------------------------------
+
+namespace eval LabelFrame {
+    Label::use
+
+    Widget::bwinclude LabelFrame Label .l \
+        remove     {
+            -highlightthickness -highlightcolor -highlightbackground
+            -takefocus -relief -borderwidth
+            -bitmap -image -cursor -textvariable
+            -dragenabled -draginitcmd -dragendcmd -dragevent -dragtype
+            -dropenabled -droptypes -dropovercmd  -dropcmd} \
+        initialize {-anchor w}
+
+    Widget::declare LabelFrame {
+        {-relief      TkResource flat 0 frame}
+        {-borderwidth TkResource 0    0 frame}
+        {-side        Enum       left 1 {left right top bottom}}
+        {-bd          Synonym    -borderwidth}
+    }
+
+    Widget::addmap LabelFrame "" :cmd {-background {}}
+    Widget::addmap LabelFrame "" .f   {-background {} -relief {} -borderwidth {}}
+
+    Widget::syncoptions LabelFrame Label .l {-text {} -underline {}}
+
+    bind BwLabelFrame <FocusIn> {Label::setfocus %W.l}
+    bind BwLabelFrame <Destroy> {Widget::destroy %W; rename %W {}}
+
+    proc ::LabelFrame { path args } { return [eval LabelFrame::create $path $args] }
+    proc use {} {}
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command LabelFrame::create
+# ------------------------------------------------------------------------------
+proc LabelFrame::create { path args } {
+    Widget::init LabelFrame $path $args
+
+    set path  [frame $path -background [Widget::getoption $path -background] \
+                   -relief flat -bd 0 -takefocus 0 -highlightthickness 0]
+
+    set label [eval Label::create $path.l [Widget::subcget $path .l] \
+                   -takefocus 0 -highlightthickness 0 -relief flat -borderwidth 0 \
+                   -dropenabled 0 -dragenabled 0]
+    set frame [eval frame $path.f [Widget::subcget $path .f] \
+                   -highlightthickness 0 -takefocus 0]
+
+    switch  [Widget::getoption $path -side] {
+        left   {set packopt "-side left"}
+        right  {set packopt "-side right"}
+        top    {set packopt "-side top -fill x"}
+        bottom {set packopt "-side bottom -fill x"}
+    }
+
+    eval pack $label $packopt
+    pack $frame -fill both -expand yes
+
+    bindtags $path [list $path BwLabelFrame [winfo toplevel $path] all]
+
+    rename $path ::$path:cmd
+    proc ::$path { cmd args } "return \[eval LabelFrame::\$cmd $path \$args\]"
+
+    return $path
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command LabelFrame::getframe
+# ------------------------------------------------------------------------------
+proc LabelFrame::getframe { path } {
+    return $path.f
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command LabelFrame::configure
+# ------------------------------------------------------------------------------
+proc LabelFrame::configure { path args } {
+    return [Widget::configure $path $args]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command LabelFrame::cget
+# ------------------------------------------------------------------------------
+proc LabelFrame::cget { path option } {
+    return [Widget::cget $path $option]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command LabelFrame::align
+#  This command align label of all widget given by args of class LabelFrame
+#  (or "derived") by setting their width to the max one +1
+# ------------------------------------------------------------------------------
+proc LabelFrame::align { args } {
+    set maxlen 0
+    set wlist  {}
+    foreach wl $args {
+        foreach w $wl {
+            if { ![info exists Widget::_class($w)] } {
+                continue
+            }
+            set class $Widget::_class($w)
+            if { ![string compare $class "LabelFrame"] } {
+                set textopt  -text
+                set widthopt -width
+            } else {
+                upvar 0 Widget::${class}::map classmap
+                set textopt  ""
+                set widthopt ""
+                set notdone  2
+                foreach {option lmap} [array get classmap] {
+                    foreach {subpath subclass realopt} $lmap {
+                        if { ![string compare $subclass "LabelFrame"] } {
+                            if { ![string compare $realopt "-text"] } {
+                                set textopt $option
+                                incr notdone -1
+                                break
+                            }
+                            if { ![string compare $realopt "-width"] } {
+                                set widthopt $option
+                                incr notdone -1
+                                break
+                            }
+                        }
+                    }
+                    if { !$notdone } {
+                        break
+                    }
+                }
+                if { $notdone } {
+                    continue
+                }
+            }
+            set len [string length [$w cget $textopt]]
+            if { $len > $maxlen } {
+                set maxlen $len
+            }
+            lappend wlist $w $widthopt
+        }
+    }
+    incr maxlen
+    foreach {w widthopt} $wlist {
+        $w configure $widthopt $maxlen
+    }
+}

lib/external/bwidget/lang/de.rc

@@ -0,0 +1,52 @@
+! ------------------------------------------------------------------------------
+!  de.rc
+!  This file is part of Unifix BWidget Toolkit
+!  Definition of german resources
+! ------------------------------------------------------------------------------
+
+
+! --- symbolic names of buttons ------------------------------------------------
+
+*abortName:   &Abbrechen
+*retryName:   &Wiederholen
+*ignoreName:  &Ignorieren
+*okName:      &OK
+*cancelName:  &Abbrechen
+*yesName:     &Ja
+*noName:      &Nein
+
+
+! --- symbolic names of label of SelectFont dialog ----------------------------
+
+*boldName:       Fett
+*italicName:     Kursiv
+*underlineName:  Unterstrichen
+*overstrikeName: Durchgestrichen
+*fontName:       &Schriftart
+*sizeName:       S&chriftgrad
+*styleName:      Sc&hriftschnitt
+
+! --- symbolic names of label of PasswdDlg dialog -----------------------------
+
+*loginName:    &Login
+*passwordName: &Password
+
+
+! --- resource for SelectFont dialog ------------------------------------------
+
+*SelectFont.title:	    Schrift Auswahl
+*SelectFont.sampletext:	    Beispieltext
+
+
+! --- resource for MessageDlg dialog ------------------------------------------
+
+*MessageDlg.noneTitle:      Meldung
+*MessageDlg.infoTitle:      Hinweis
+*MessageDlg.questionTitle:  Frage
+*MessageDlg.warningTitle:   Warnung
+*MessageDlg.errorTitle:     Fehler
+
+
+! --- resource for PasswdDlg dialog -------------------------------------------
+
+*PasswdDlg.title:  Enter login and password

lib/external/bwidget/lang/en.rc

@@ -0,0 +1,52 @@
+! ------------------------------------------------------------------------------
+!  en.rc
+!  This file is part of Unifix BWidget Toolkit
+!  Definition of english resources
+! ------------------------------------------------------------------------------
+
+
+! --- symbolic names of buttons ------------------------------------------------
+
+*abortName:   &Abort
+*retryName:   &Retry
+*ignoreName:  &Ignore
+*okName:      &OK
+*cancelName:  &Cancel
+*yesName:     &Yes
+*noName:      &No
+
+
+! --- symbolic names of label of SelectFont dialog ----------------------------
+
+*boldName:       Bold
+*italicName:     Italic
+*underlineName:  Underline
+*overstrikeName: Overstrike
+*fontName:       &Font
+*sizeName:       &Size
+*styleName:      St&yle
+
+
+! --- symbolic names of label of PasswdDlg dialog -----------------------------
+
+*loginName:    &Login
+*passwordName: &Password
+
+
+! --- resource for SelectFont dialog ------------------------------------------
+
+*SelectFont.title:	    Font selection
+*SelectFont.sampletext:	    Sample text
+
+
+! --- resource for MessageDlg dialog ------------------------------------------
+
+*MessageDlg.noneTitle:      Message
+*MessageDlg.infoTitle:      Information
+*MessageDlg.questionTitle:  Question
+*MessageDlg.warningTitle:   Warning
+*MessageDlg.errorTitle:     Error
+
+! --- resource for PasswdDlg dialog -------------------------------------------
+
+*PasswdDlg.title:  Enter login and password

lib/external/bwidget/lang/es.rc

@@ -0,0 +1,53 @@
+! ------------------------------------------------------------------------------
+!  es.rc
+!  This file is part of Unifix BWidget Toolkit
+!  Definition of spanish resources
+!  daniel@rawbyte.com
+! ------------------------------------------------------------------------------
+
+
+! --- symbolic names of buttons ------------------------------------------------
+
+*abortName:    A&bortar
+*retryName:    &Reintentar
+*ignoreName:   &Ignorar
+*okName:       &OK
+*cancelName:   &Anular
+*yesName:      &Sí 
+*noName:       &No
+
+! --- symbolic names of label of SelectFont dialog ----------------------------
+
+*boldName:       &Negrita
+*italicName:     &Cursiva
+*underlineName:  &Subrayado
+*overstrikeName: &Tachado
+*fontName:       &Fuente
+*sizeName:       &Tamaño
+*styleName:      &Estilo
+
+
+! --- symbolic names of label of PasswdDlg dialog -----------------------------
+
+*loginName:    Nombre de &usuario
+*passwordName: &Contraseña 
+
+! --- resource for SelectFont dialog ------------------------------------------
+
+*SelectFont.title:        Selección de fuente
+*SelectFont.sampletext:   Texto de Ejemplo
+
+
+! --- resource for MessageDlg dialog ------------------------------------------
+
+*MessageDlg.noneTitle:      Indicación
+*MessageDlg.infoTitle:      Información
+*MessageDlg.questionTitle:  Pregunta
+*MessageDlg.warningTitle:   Atención
+*MessageDlg.errorTitle:     Error
+
+
+! --- resource for PasswdDlg dialog -------------------------------------------
+
+*PasswdDlg.title:  Introduzca su nombre de usuario y contraseña
+

lib/external/bwidget/lang/fr.rc

@@ -0,0 +1,52 @@
+! ------------------------------------------------------------------------------
+!  fr.rc
+!  This file is part of Unifix BWidget Toolkit
+!  Definition of french resources
+! ------------------------------------------------------------------------------
+
+
+! --- symbolic names of buttons ------------------------------------------------
+
+*abortName:    A&bandonner
+*retryName:    &Réessayer
+*ignoreName:   &Ignorer
+*okName:       &OK
+*cancelName:   &Annuler
+*yesName:      &Oui
+*noName:       &Non
+
+! --- symbolic names of label of SelectFont dialog ----------------------------
+
+*boldName:       &Gras
+*italicName:     &Italique
+*underlineName:  &Souligné
+*overstrikeName: &Barré
+*fontName:       &Police
+*sizeName:       &Taille
+*styleName:      St&yle
+
+
+! --- symbolic names of label of PasswdDlg dialog -----------------------------
+
+*loginName:    Nom de l'&utilisateur
+*passwordName: Mot de &passe
+
+
+! --- resource for SelectFont dialog ------------------------------------------
+
+*SelectFont.title:        Sélection d'une police
+*SelectFont.sampletext:	  Texte d'exemple
+
+
+! --- resource for MessageDlg dialog ------------------------------------------
+
+*MessageDlg.noneTitle:      Message
+*MessageDlg.infoTitle:      Information
+*MessageDlg.questionTitle:  Question
+*MessageDlg.warningTitle:   Attention
+*MessageDlg.errorTitle:     Erreur
+
+
+! --- resource for PasswdDlg dialog -------------------------------------------
+
+*PasswdDlg.title:  Entrez le login et le mot de passe

lib/external/bwidget/mainframe.tcl

@@ -0,0 +1,517 @@
+# ------------------------------------------------------------------------------
+#  mainframe.tcl
+#  This file is part of Unifix BWidget Toolkit
+#  $Id$
+# ------------------------------------------------------------------------------
+#  Index of commands:
+#     - MainFrame::create
+#     - MainFrame::configure
+#     - MainFrame::cget
+#     - MainFrame::getframe
+#     - MainFrame::addtoolbar
+#     - MainFrame::gettoolbar
+#     - MainFrame::addindicator
+#     - MainFrame::getindicator
+#     - MainFrame::getmenu
+#     - MainFrame::showtoolbar
+#     - MainFrame::showstatusbar
+#     - MainFrame::_create_menubar
+#     - MainFrame::_create_entries
+#     - MainFrame::_parse_name
+#     - MainFrame::_parse_accelerator
+# ------------------------------------------------------------------------------
+
+if [catch {package require msgcat}] {
+	proc G_msg {message} {
+		return $message
+	}
+} else {
+	::msgcat::mcload $env(GISBASE)/etc/msgs
+	proc G_msg {message} {
+		return [::msgcat::mc $message]
+	}
+}
+
+namespace eval MainFrame {
+    ProgressBar::use
+
+    Widget::bwinclude MainFrame ProgressBar .status.prg \
+        remove {
+            -fg -bg -bd -troughcolor -background -borderwidth
+            -relief -orient -width -height
+        } \
+        rename {
+            -maximum    -progressmax
+            -variable   -progressvar
+            -type       -progresstype
+            -foreground -progressfg
+        }
+
+    Widget::declare MainFrame {
+        {-width        TkResource 0      0 frame}
+        {-height       TkResource 0      0 frame}
+        {-background   TkResource ""     0 frame}
+        {-textvariable String     ""     0}
+        {-menu         String     {}     1}
+        {-separator    Enum       both   1 {none top bottom both}}
+        {-bg           Synonym    -background}
+    }
+
+    Widget::addmap MainFrame "" .frame  {-width {} -height {} -background {}}
+    Widget::addmap MainFrame "" .topf   {-background {}}
+    Widget::addmap MainFrame "" .botf   {-background {}}
+    Widget::addmap MainFrame "" .status {-background {}}
+    Widget::addmap MainFrame "" .status.label {-background {}}
+    Widget::addmap MainFrame "" .status.indf  {-background {}}
+    Widget::addmap MainFrame "" .status.prgf  {-background {}}
+    Widget::addmap MainFrame ProgressBar .status.prg {-background {} -background -troughcolor}
+
+    proc ::MainFrame { path args } { return [eval MainFrame::create $path $args] }
+    proc use {} {}
+
+    variable _widget
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command MainFrame::create
+# ------------------------------------------------------------------------------
+proc MainFrame::create { path args } {
+    global   tcl_platform
+    variable _widget
+
+    set path [frame $path -takefocus 0 -highlightthickness 0]
+    set top  [winfo parent $path]
+    if { [string compare [winfo toplevel $path] $top] } {
+        destroy $path
+        return -code error "parent must be a toplevel"
+    }
+    Widget::init MainFrame $path $args
+
+    set bg [Widget::getoption $path -background]
+    if { $tcl_platform(platform) == "unix" } {
+        set relief raised
+        set bd     1
+    } else {
+        set relief flat
+        set bd     0
+    }
+    $path configure -background $bg
+    set topframe  [frame $path.topf -relief flat -borderwidth 0 -background $bg]
+    set userframe [eval frame $path.frame [Widget::subcget $path .frame] \
+                       -relief $relief -borderwidth $bd]
+    set botframe  [frame $path.botf -relief $relief -borderwidth $bd -background $bg]
+
+    pack $topframe -fill x
+    grid columnconfigure $topframe 0 -weight 1
+
+    if { $tcl_platform(platform) != "unix" } {
+        set sepopt [Widget::getoption $path -separator]
+        if { $sepopt == "both" || $sepopt == "top" } {
+            set sep [Separator::create $path.sep -orient horizontal -background $bg]
+            pack $sep -fill x
+        }
+        if { $sepopt == "both" || $sepopt == "bottom" } {
+            set sep [Separator::create $botframe.sep -orient horizontal -background $bg]
+            pack $sep -fill x
+        }
+    }
+
+    # --- status bar -------------------------------------------------------------------------
+    set status   [frame $path.status -relief flat -borderwidth 0 \
+                      -takefocus 0 -highlightthickness 0 -background $bg]
+    set label    [label $status.label -textvariable [Widget::getoption $path -textvariable] \
+                      -takefocus 0 -highlightthickness 0 -background $bg]
+    set indframe [frame $status.indf -relief flat -borderwidth 0 \
+                      -takefocus 0 -highlightthickness 0 -background $bg]
+    set prgframe [frame $status.prgf -relief flat -borderwidth 0 \
+                      -takefocus 0 -highlightthickness 0 -background $bg]
+
+    place $label    -anchor w -x 0 -rely 0.5
+    place $indframe -anchor e -relx 1 -rely 0.5
+    pack  $prgframe -in $indframe -side left -padx 2
+    $status configure -height [winfo reqheight $label]
+
+    set progress [eval ProgressBar::create $status.prg [Widget::subcget $path .status.prg] \
+                      -width       50 \
+                      -height      [expr {[winfo reqheight $label]-2}] \
+                      -borderwidth 1 \
+                      -relief      sunken]
+    pack $status    -in $botframe -fill x -pady 2
+    pack $botframe  -side bottom -fill x
+    pack $userframe -fill both -expand yes
+
+    set _widget($path,top)      $top
+    set _widget($path,ntoolbar) 0
+    set _widget($path,nindic)   0
+
+    set menu [Widget::getoption $path -menu]
+    if { [llength $menu] } {
+        _create_menubar $path $menu
+    }
+
+    bind $path <Destroy> {MainFrame::_destroy %W}
+
+    rename $path ::$path:cmd
+    proc ::$path { cmd args } "return \[eval MainFrame::\$cmd $path \$args\]"
+
+    return $path
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command MainFrame::configure
+# ------------------------------------------------------------------------------
+proc MainFrame::configure { path args } {
+    variable _widget
+
+    set res [Widget::configure $path $args]
+
+    if { [Widget::hasChanged $path -textvariable newv] } {
+        uplevel \#0 $path.status.label configure -textvariable [list $newv]
+    }
+
+    if { [Widget::hasChanged $path -background bg] } {
+        set listmenu [$_widget($path,top) cget -menu]
+        while { [llength $listmenu] } {
+            set newlist {}
+            foreach menu $listmenu {
+                $menu configure -background $bg
+                set newlist [concat $newlist [winfo children $menu]]
+            }
+            set listmenu $newlist
+        }
+        foreach sep {.sep .botf.sep} {
+            if { [winfo exists $path.$sep] } {
+                Separator::configure $path.$sep -background $bg
+            }
+        }
+        foreach w [winfo children $path.topf] {
+            $w configure -background $bg
+        }
+    }
+    return $res
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command MainFrame::cget
+# ------------------------------------------------------------------------------
+proc MainFrame::cget { path option } {
+    return [Widget::cget $path $option]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command MainFrame::getframe
+# ------------------------------------------------------------------------------
+proc MainFrame::getframe { path } {
+    return $path.frame
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command MainFrame::addtoolbar
+# ------------------------------------------------------------------------------
+proc MainFrame::addtoolbar { path } {
+    global   tcl_platform
+    variable _widget
+
+    set index     $_widget($path,ntoolbar)
+    set toolframe $path.topf.f$index
+    set toolbar   $path.topf.tb$index
+    set bg        [Widget::getoption $path -background]
+    if { $tcl_platform(platform) == "unix" } {
+        frame $toolframe -relief raised -borderwidth 1 \
+            -takefocus 0 -highlightthickness 0 -background $bg
+    } else {
+        frame $toolframe -relief flat -borderwidth 0 -takefocus 0 \
+            -highlightthickness 0 -background $bg
+        set sep [Separator::create $toolframe.sep -orient horizontal -background $bg]
+        pack $sep -fill x
+    }
+    set toolbar [frame $toolbar -relief flat -borderwidth 2 \
+                     -takefocus 0 -highlightthickness 0 -background $bg]
+    pack $toolbar -in $toolframe -anchor w
+    incr _widget($path,ntoolbar)
+    grid $toolframe -column 0 -row $index -sticky ew
+    return $toolbar
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command MainFrame::gettoolbar
+# ------------------------------------------------------------------------------
+proc MainFrame::gettoolbar { path index } {
+    return $path.topf.tb$index
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command MainFrame::addindicator
+# ------------------------------------------------------------------------------
+proc MainFrame::addindicator { path args } {
+    variable _widget
+
+    set index $_widget($path,nindic)
+    set indic $path.status.indf.f$index
+    eval label $indic $args -relief sunken -borderwidth 1 \
+        -takefocus 0 -highlightthickness 0
+
+    pack $indic -side left -anchor w -padx 2
+
+    incr _widget($path,nindic)
+
+    return $indic
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command MainFrame::getindicator
+# ------------------------------------------------------------------------------
+proc MainFrame::getindicator { path index } {
+    return $path.status.indf.f$index
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command MainFrame::getmenu
+# ------------------------------------------------------------------------------
+proc MainFrame::getmenu { path menuid } {
+    variable _widget
+
+    if { [info exists _widget($path,menuid,$menuid)] } {
+        return $_widget($path,menuid,$menuid)
+    }
+    return ""
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command MainFrame::setmenustate
+# ------------------------------------------------------------------------------
+proc MainFrame::setmenustate { path tag state } {
+    variable _widget
+
+    if { [info exists _widget($path,tags,$tag)] } {
+        foreach {menu entry} $_widget($path,tags,$tag) {
+            $menu entryconfigure $entry -state $state
+        }
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command MainFrame::showtoolbar
+# ------------------------------------------------------------------------------
+proc MainFrame::showtoolbar { path index bool } {
+    variable _widget
+
+    set toolframe $path.topf.f$index
+    if { [winfo exists $toolframe] } {
+        if { !$bool && [llength [grid info $toolframe]] } {
+            grid forget $toolframe
+            $path.topf configure -height 1
+        } elseif { $bool && ![llength [grid info $toolframe]] } {
+            grid $toolframe -column 0 -row $index -sticky ew
+        }
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command MainFrame::showstatusbar
+# ------------------------------------------------------------------------------
+proc MainFrame::showstatusbar { path name } {
+    set status $path.status
+    if { ![string compare $name "none"] } {
+        pack forget $status
+    } else {
+        pack $status -fill x
+        switch -- $name {
+            status {
+                catch {pack forget $status.prg}
+            }
+            progression {
+                pack $status.prg -in $status.prgf
+            }
+        }
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command MainFrame::_destroy
+# ------------------------------------------------------------------------------
+proc MainFrame::_destroy { path } {
+    variable _widget
+
+    Widget::destroy $path
+    catch {destroy [$_widget($path,top) cget -menu]}
+    $_widget($path,top) configure -menu {}
+    unset _widget($path,top)
+    unset _widget($path,ntoolbar)
+    unset _widget($path,nindic)
+    rename $path {}
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command MainFrame::_create_menubar
+# ------------------------------------------------------------------------------
+proc MainFrame::_create_menubar { path descmenu } {
+    variable _widget
+    global    tcl_platform
+
+    set bg      [Widget::getoption $path -background]
+    set top     $_widget($path,top)
+    if { $tcl_platform(platform) == "unix" } {
+        set menubar [menu $top.menubar -tearoff 0 -background $bg -borderwidth 1]
+    } else {
+        set menubar [menu $top.menubar -tearoff 0 -background $bg]
+    }
+    $top configure -menu $menubar
+
+    set count 0
+    foreach {name tags menuid tearoff entries} $descmenu {
+        set opt  [_parse_name [G_msg $name]]
+        if { [string length $menuid] && ![info exists _widget($path,menuid,$menuid)] } {
+            # menu has identifier
+	    # we use it for its pathname, to enable special menu entries
+	    # (help, system, ...)
+	    set menu $menubar.$menuid
+        } else {
+	    set menu $menubar.menu$count
+	}
+        eval $menubar add cascad $opt -menu $menu
+        menu $menu -tearoff $tearoff -background $bg
+        foreach tag $tags {
+            lappend _widget($path,tags,$tag) $menubar $count
+        }
+        if { [string length $menuid] } {
+            # menu has identifier
+            set _widget($path,menuid,$menuid) $menu
+        }
+        _create_entries $path $menu $bg $entries
+        incr count
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command MainFrame::_create_entries
+# ------------------------------------------------------------------------------
+proc MainFrame::_create_entries { path menu bg entries } {
+    variable _widget
+
+    set count      [$menu cget -tearoff]
+    set registered 0
+    foreach entry $entries {
+        set len  [llength $entry]
+        set type [lindex $entry 0]
+
+        if { ![string compare $type "separator"] } {
+            $menu add separator
+            incr count
+            continue
+        }
+
+        # entry name and tags
+        set opt  [_parse_name [G_msg [lindex $entry 1]]]
+        set tags [lindex $entry 2]
+        foreach tag $tags {
+            lappend _widget($path,tags,$tag) $menu $count
+        }
+
+        if { ![string compare $type "cascad"] } {
+            set menuid  [lindex $entry 3]
+            set tearoff [lindex $entry 4]
+            set submenu $menu.menu$count
+            eval $menu add cascad $opt -menu $submenu
+            menu $submenu -tearoff $tearoff -background $bg
+            if { [string length $menuid] } {
+                # menu has identifier
+                set _widget($path,menuid,$menuid) $submenu
+            }
+            _create_entries $path $submenu $bg [lindex $entry 5]
+            incr count
+            continue
+        }
+
+        # entry help description
+        set desc [G_msg [lindex $entry 3]]
+        if { [string length $desc] } {
+            if { !$registered } {
+                DynamicHelp::register $menu menu [Widget::getoption $path -textvariable]
+                set registered 1
+            }
+            DynamicHelp::register $menu menuentry $count $desc
+        }
+
+        # entry accelerator
+        set accel [_parse_accelerator [lindex $entry 4]]
+        if { [llength $accel] } {
+            lappend opt -accelerator [lindex $accel 0]
+            bind $_widget($path,top) [lindex $accel 1] "$menu invoke $count"
+        }
+
+        # user options
+        set useropt [lrange $entry 5 end]
+        if { ![string compare $type "command"] || 
+             ![string compare $type "radiobutton"] ||
+             ![string compare $type "checkbutton"] } {
+            eval $menu add $type $opt $useropt
+        } else {
+            return -code error "invalid menu type \"$type\""
+        }
+        incr count
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command MainFrame::_parse_name
+# ------------------------------------------------------------------------------
+proc MainFrame::_parse_name { menuname } {
+    set idx [string first "&" $menuname]
+    if { $idx == -1 } {
+        return [list -label $menuname]
+    } else {
+        set beg [string range $menuname 0 [expr $idx-1]]
+        set end [string range $menuname [expr $idx+1] end]
+        append beg $end
+        return [list -label $beg -underline $idx]
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command MainFrame::_parse_accelerator
+# ------------------------------------------------------------------------------
+proc MainFrame::_parse_accelerator { desc } {
+    if { [llength $desc] == 2 } {
+        set seq [lindex $desc 0]
+        set key [lindex $desc 1]
+        switch -- $seq {
+            Ctrl {
+                set accel "Ctrl+[string toupper $key]"
+                set event "<Control-Key-[string tolower $key]>"
+            }
+            Alt {
+                set accel "Atl+[string toupper $key]"
+                set event "<Alt-Key-[string tolower $key]>"
+            }
+            CtrlAlt {
+                set accel "Ctrl+Alt+[string toupper $key]"
+                set event "<Control-Alt-Key-[string tolower $key]>"
+            }
+            default {
+                return -code error "invalid accelerator code $seq"
+            }
+        }
+        return [list $accel $event]
+    }
+    return {}
+}
+
+

lib/external/bwidget/messagedlg.tcl

@@ -0,0 +1,111 @@
+# ------------------------------------------------------------------------------
+#  messagedlg.tcl
+#  This file is part of Unifix BWidget Toolkit
+# ------------------------------------------------------------------------------
+#  Index of commands:
+#     - MessageDlg::create
+# ------------------------------------------------------------------------------
+
+namespace eval MessageDlg {
+    Dialog::use
+
+    Widget::tkinclude MessageDlg message .frame.msg \
+        remove     {-cursor -highlightthickness -highlightbackground -highlightcolor \
+                        -relief -borderwidth -takefocus -textvariable} \
+        rename     {-text -message} \
+        initialize {-aspect 800 -anchor c -justify center}
+
+    Widget::bwinclude MessageDlg Dialog "" \
+        remove {-modal -image -bitmap -side -anchor -separator \
+                    -homogeneous -padx -pady -spacing}
+
+    Widget::declare MessageDlg {
+        {-icon       Enum   info 0 {none error info question warning}}
+        {-type       Enum   user 0 {abortretryignore ok okcancel retrycancel yesno yesnocancel user}}
+        {-buttons    String ""   0}
+    }
+
+    proc ::MessageDlg { path args } { return [eval MessageDlg::create $path $args] }
+    proc use { } {}
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command MessageDlg::create
+# ------------------------------------------------------------------------------
+proc MessageDlg::create { path args } {
+    global tcl_platform
+
+    Widget::init MessageDlg "$path#Message" $args
+    set type  [Widget::getoption "$path#Message" -type]
+    set title [Widget::getoption "$path#Message" -title]
+    set icon  [Widget::getoption "$path#Message" -icon]
+    set defb  -1
+    set canb  -1
+    switch -- $type {
+        abortretryignore {set lbut {abort retry ignore}}
+        ok               {set lbut {ok}; set defb 0 }
+        okcancel         {set lbut {ok cancel}; set defb 0; set canb 1}
+        retrycancel      {set lbut {retry cancel}; set defb 0; set canb 1}
+        yesno            {set lbut {yes no}; set defb 0; set canb 1}
+        yesnocancel      {set lbut {yes no cancel}; set defb 0; set canb 2}
+        user             {set lbut [Widget::getoption "$path#Message" -buttons]}
+    }
+    if { [Widget::getoption "$path#Message" -default] == -1 } {
+        Widget::setoption "$path#Message" -default $defb
+    }
+    if { [Widget::getoption "$path#Message" -cancel] == -1 } {
+        Widget::setoption "$path#Message" -cancel $canb
+    }
+    if { $title == "" } {
+        set frame [frame $path -class MessageDlg]
+        set title [option get $frame "${icon}Title" MessageDlg]
+        destroy $frame
+        if { $title == "" } {
+            set title "Message"
+        }
+    }
+    Widget::setoption "$path#Message" -title $title
+    if { $tcl_platform(platform) == "unix" || $type == "user" } {
+        if { $icon != "none" } {
+            set image [Bitmap::get $icon]
+        } else {
+            set image ""
+        }
+        eval Dialog::create $path [Widget::subcget "$path#Message" ""] \
+            -image $image -modal local -side bottom -anchor c
+        set idbut 0
+        foreach but $lbut {
+            Dialog::add $path -text $but -name $but
+        }
+        set frame [Dialog::getframe $path]
+
+        eval message $frame.msg [Widget::subcget "$path#Message" .frame.msg] \
+            -relief flat -borderwidth 0 -highlightthickness 0 -textvariable {""}
+        pack  $frame.msg -side left -padx 3m -pady 1m -fill x -expand yes
+
+        set res [Dialog::draw $path]
+    } else {
+        set parent [Widget::getoption "$path#Message" -parent]
+        set def    [lindex $lbut [Widget::getoption "$path#Message" -default]]
+        set opt    [list \
+                        -message [Widget::getoption "$path#Message" -message] \
+                        -type    $type  \
+                        -title   $title]
+        if { [winfo exists $parent] } {
+           lappend opt -parent $parent
+        }
+        if { $def != "" } {
+           lappend opt -default $def
+        }
+        if { $icon != "none" } {
+           lappend opt -icon $icon
+        }
+        set res [eval tk_messageBox $opt]
+        set res [lsearch $lbut $res]
+    }
+    Widget::destroy "$path#Message"
+    destroy $path
+
+    return $res
+}

lib/external/bwidget/notebook.tcl

@@ -0,0 +1,866 @@
+# ------------------------------------------------------------------------------
+#  notebook.tcl
+#  This file is part of Unifix BWidget Toolkit
+#  $Id$
+# ------------------------------------------------------------------------------
+#  Index of commands:
+#     - NoteBook::create
+#     - NoteBook::configure
+#     - NoteBook::cget
+#     - NoteBook::compute_size
+#     - NoteBook::insert
+#     - NoteBook::delete
+#     - NoteBook::itemconfigure
+#     - NoteBook::itemcget
+#     - NoteBook::bindtabs
+#     - NoteBook::raise
+#     - NoteBook::see
+#     - NoteBook::page
+#     - NoteBook::pages
+#     - NoteBook::index
+#     - NoteBook::getframe
+#     - NoteBook::_test_page
+#     - NoteBook::_itemconfigure
+#     - NoteBook::_compute_width
+#     - NoteBook::_get_x_page
+#     - NoteBook::_xview
+#     - NoteBook::_highlight
+#     - NoteBook::_select
+#     - NoteBook::_redraw
+#     - NoteBook::_draw_page
+#     - NoteBook::_draw_arrows
+#     - NoteBook::_draw_area
+#     - NoteBook::_resize
+#     - NoteBook::_realize
+# ------------------------------------------------------------------------------
+
+namespace eval NoteBook {
+    ArrowButton::use
+
+    namespace eval Page {
+        Widget::declare NoteBook::Page {
+            {-state      Enum       normal 0 {normal disabled}}
+            {-createcmd  String     ""     0}
+            {-raisecmd   String     ""     0}
+            {-leavecmd   String     ""     0}
+            {-image      TkResource ""     0 label}
+            {-text       String     ""     0}
+        }
+    }
+
+    Widget::declare NoteBook {
+        {-foreground         TkResource "" 0 button}
+        {-background         TkResource "" 0 button}
+        {-activebackground   TkResource "" 0 button}
+        {-activeforeground   TkResource "" 0 button}
+        {-disabledforeground TkResource "" 0 button}
+        {-font               TkResource "" 0 button}
+        {-side               Enum       top 1 {top bottom}}
+        {-homogeneous        Boolean 0   0}
+        {-borderwidth        Int 1   0 {=1 =2}}
+        {-width              Int 0   0 {=0 ""}}
+        {-height             Int 0   0 {=0 ""}}
+
+        {-repeatdelay        BwResource ""  0 ArrowButton}
+        {-repeatinterval     BwResource ""  0 ArrowButton}
+
+        {-fg                 Synonym -foreground}
+        {-bg                 Synonym -background}
+        {-bd                 Synonym -borderwidth}
+    }
+
+    Widget::addmap NoteBook "" :cmd {-background {}}
+    Widget::addmap NoteBook ArrowButton .fg \
+        {-foreground {} -background {} -activeforeground {} -activebackground {} \
+             -borderwidth {} -repeatinterval {} -repeatdelay {} -disabledforeground {}}
+    Widget::addmap NoteBook ArrowButton .fd \
+        {-foreground {} -background {} -activeforeground {} -activebackground {} \
+             -borderwidth {} -repeatinterval {} -repeatdelay {} -disabledforeground {}}
+
+    variable _warrow 12
+
+    proc ::NoteBook { path args } { return [eval NoteBook::create $path $args] }
+    proc use {} {}
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command NoteBook::create
+# ------------------------------------------------------------------------------
+proc NoteBook::create { path args } {
+    variable $path
+    upvar 0  $path data
+
+    Widget::init NoteBook $path $args
+
+    set data(base)     0
+    set data(select)   ""
+    set data(pages)    {}
+    set data(pages)    {}
+    set data(cpt)      0
+    set data(realized) 0
+    set data(wpage)    0
+    set data(hpage)    [expr {[font metrics [Widget::getoption $path -font] -linespace] + 6}]
+    set bg             [Widget::getoption $path -background]
+
+    # --- creation du canvas -----------------------------------------------------------------
+    set w [expr {[Widget::getoption $path -width]+4}]
+    set h [expr {[Widget::getoption $path -height]+$data(hpage)+4}]
+    canvas $path -relief flat -bd 0 -highlightthickness 0 -bg $bg -width $w -height $h
+
+    # --- creation des arrow -----------------------------------------------------------------
+    eval ArrowButton::create $path.fg [Widget::subcget $path .fg] \
+        -highlightthickness 0 \
+        -type button  -dir left \
+        -armcommand [list "NoteBook::_xview $path -1"]
+
+    eval ArrowButton::create $path.fd [Widget::subcget $path .fd] \
+        -highlightthickness 0 \
+        -type button  -dir right \
+        -armcommand [list "NoteBook::_xview $path 1"]
+
+    set col       [BWidget::get3dcolor $path $bg]
+    set data(dbg) [lindex $col 0]
+    set data(lbg) [lindex $col 1]
+
+    bind $path <Configure> "NoteBook::_realize $path"
+    bind $path <Destroy>   "NoteBook::_destroy $path"
+
+    rename $path ::$path:cmd
+    proc ::$path { cmd args } "return \[eval NoteBook::\$cmd $path \$args\]"
+
+    return $path
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command NoteBook::configure
+# ------------------------------------------------------------------------------
+proc NoteBook::configure { path args } {
+    variable $path
+    upvar 0  $path data
+
+    set res [Widget::configure $path $args]
+    set redraw 0
+    if { [set chf [Widget::hasChanged $path -font font]] ||
+         [Widget::hasChanged $path -homogeneous foo] } {
+        if { $chf } {
+            set data(hpage) [expr {[font metrics $font -linespace] + 6}]
+        }
+        _compute_width $path
+        set redraw 1
+    }
+    if { [Widget::hasChanged $path -background bg] } {
+        set col [BWidget::get3dcolor $path $bg]
+        set data(dbg)  [lindex $col 0]
+        set data(lbg)  [lindex $col 1]
+        set redraw 1
+    }
+    if { [Widget::hasChanged $path -foreground  fg] ||
+         [Widget::hasChanged $path -borderwidth bd] } {
+        set redraw 1
+    }
+    set wc [Widget::hasChanged $path -width  w]
+    set hc [Widget::hasChanged $path -height h]
+    if { $wc || $hc } {
+        $path:cmd configure -width [expr {$w+4}] -height [expr {$h + $data(hpage)+4}]
+    } elseif { $redraw } {
+        _redraw $path
+    }
+
+    return $res
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command NoteBook::cget
+# ------------------------------------------------------------------------------
+proc NoteBook::cget { path option } {
+    return [Widget::cget $path $option]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command NoteBook::compute_size
+# ------------------------------------------------------------------------------
+proc NoteBook::compute_size { path } {
+    variable $path
+    upvar 0  $path data
+
+    set wmax 0
+    set hmax 0
+    update idletasks
+    foreach page $data(pages) {
+        set w    [winfo reqwidth  $path.f$page]
+        set h    [winfo reqheight $path.f$page]
+        set wmax [expr {$w>$wmax ? $w : $wmax}]
+        set hmax [expr {$h>$hmax ? $h : $hmax}]
+    }
+    configure $path -width $wmax -height $hmax
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command NoteBook::insert
+# ------------------------------------------------------------------------------
+proc NoteBook::insert { path index page args } {
+    variable $path
+    upvar 0  $path data
+
+    if { [lsearch $data(pages) $page] != -1 } {
+        return -code error "page \"$page\" already exists"
+    }
+
+    Widget::init NoteBook::Page $path.f$page $args
+
+    set data(pages) [linsert $data(pages) $index $page]
+    if { ![winfo exists $path.f$page] } {
+        frame $path.f$page \
+            -relief flat -background [Widget::getoption $path -background] -borderwidth 10
+        set data($page,realized) 0
+    }
+    _compute_width $path
+    _draw_page $path $page 1
+    _redraw $path
+
+    return $path.f$page
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command NoteBook::delete
+# ------------------------------------------------------------------------------
+proc NoteBook::delete { path page {destroyframe 1} } {
+    variable $path
+    upvar 0  $path data
+
+    set pos [_test_page $path $page]
+    set data(pages) [lreplace $data(pages) $pos $pos]
+    _compute_width $path
+    $path:cmd delete p:$page
+    if { $data(select) == $page } {
+        set data(select) ""
+    }
+    if { $pos < $data(base) } {
+        incr data(base) -1
+    }
+    if { $destroyframe } {
+        destroy $path.f$page
+    }
+    _redraw $path
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command NoteBook::itemconfigure
+# ------------------------------------------------------------------------------
+proc NoteBook::itemconfigure { path page args } {
+    _test_page $path $page
+    set res [_itemconfigure $path $page $args]
+    _redraw $path
+
+    return $res
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command NoteBook::itemcget
+# ------------------------------------------------------------------------------
+proc NoteBook::itemcget { path page option } {
+    _test_page $path $page
+    return [Widget::cget $path.f$page $option]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command NoteBook::bindtabs
+# ------------------------------------------------------------------------------
+proc NoteBook::bindtabs { path event script } {
+    if { $script != "" } {
+        $path:cmd bind "page" $event \
+            "$script \[string range \[lindex \[$path:cmd gettags current\] 1\] 2 end\]"
+    } else {
+        $path:cmd bind "page" $event {}
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command NoteBook::move
+# ------------------------------------------------------------------------------
+proc NoteBook::move { path page index } {
+    variable $path
+    upvar 0  $path data
+
+    set pos [_test_page $path $page]
+    set data(pages) [linsert [lreplace $data(pages) $pos $pos] $index $page]
+    _redraw $path
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command NoteBook::raise
+# ------------------------------------------------------------------------------
+proc NoteBook::raise { path {page ""} } {
+    variable $path
+    upvar 0  $path data
+
+    if { $page != "" } {
+        _test_page $path $page
+        _select $path $page
+    }
+    return $data(select)
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command NoteBook::see
+# ------------------------------------------------------------------------------
+proc NoteBook::see { path page } {
+    variable $path
+    upvar 0  $path data
+
+    set pos [_test_page $path $page]
+    if { $pos < $data(base) } {
+        set data(base) $pos
+        _redraw $path
+    } else {
+        set w     [expr {[winfo width $path]-1}]
+        set fpage [expr {[_get_x_page $path $pos] + $data($page,width) + 6}]
+        set idx   $data(base)
+        while { $idx < $pos && $fpage > $w } {
+            set fpage [expr {$fpage - $data([lindex $data(pages) $idx],width)}]
+            incr idx
+        }
+        if { $idx != $data(base) } {
+            set data(base) $idx
+            _redraw $path
+        }
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command NoteBook::page
+# ------------------------------------------------------------------------------
+proc NoteBook::page { path first {last ""} } {
+    variable $path
+    upvar 0  $path data
+
+    if { $last == "" } {
+        return [lindex $data(pages) $first]
+    } else {
+        return [lrange $data(pages) $first $last]
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command NoteBook::pages
+# ------------------------------------------------------------------------------
+proc NoteBook::pages { path {first ""} {last ""}} {
+    variable $path
+    upvar 0  $path data
+
+    if { ![string length $first] } {
+	return $data(pages)
+    }
+
+    if { ![string length $last] } {
+        return [lindex $data(pages) $first]
+    } else {
+        return [lrange $data(pages) $first $last]
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command NoteBook::index
+# ------------------------------------------------------------------------------
+proc NoteBook::index { path page } {
+    variable $path
+    upvar 0  $path data
+
+    return [lsearch $data(pages) $page]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command NoteBook::_destroy
+# ------------------------------------------------------------------------------
+proc NoteBook::_destroy { path } {
+    variable $path
+    upvar 0  $path data
+
+    foreach page $data(pages) {
+        Widget::destroy $path.f$page
+    }
+    Widget::destroy $path
+    unset data
+    rename $path {}
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command NoteBook::getframe
+# ------------------------------------------------------------------------------
+proc NoteBook::getframe { path page } {
+    return $path.f$page
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command NoteBook::_test_page
+# ------------------------------------------------------------------------------
+proc NoteBook::_test_page { path page } {
+    variable $path
+    upvar 0  $path data
+
+    if { [set pos [lsearch $data(pages) $page]] == -1 } {
+        return -code error "page \"$page\" does not exists"
+    }
+    return $pos
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command NoteBook::_itemconfigure
+# ------------------------------------------------------------------------------
+proc NoteBook::_itemconfigure { path page lres } {
+    variable $path
+    upvar 0  $path data
+
+    set res [Widget::configure $path.f$page $lres]
+    if { [Widget::hasChanged $path.f$page -text foo] } {
+        _compute_width $path
+    } elseif  { [Widget::hasChanged $path.f$page -image foo] } {
+        set data(hpage) [expr {[font metrics [Widget::getoption $path -font] -linespace] + 6}]
+        _compute_width $path
+    }
+    if { [Widget::hasChanged $path.f$page -state state] &&
+         $state == "disabled" && $data(select) == $page } {
+        set data(select) ""
+    }
+    return $res
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command NoteBook::_compute_width
+# ------------------------------------------------------------------------------
+proc NoteBook::_compute_width { path } {
+    variable $path
+    upvar 0  $path data
+
+    set font [Widget::getoption $path -font]
+    set wmax 0
+    set hmax $data(hpage)
+    set wtot 0
+    if { ![info exists data(textid)] } {
+        set data(textid) [$path:cmd create text 0 -100 -font [Widget::getoption $path -font] -anchor nw]
+    }
+    set id $data(textid)
+    $path:cmd itemconfigure $id -font [Widget::getoption $path -font]
+    foreach page $data(pages) {
+        $path:cmd itemconfigure $id -text [Widget::getoption $path.f$page -text]
+        set  wtext [expr {[lindex [$path:cmd bbox $id] 2]+20}]
+        if { [set img [Widget::getoption $path.f$page -image]] != "" } {
+            set wtext [expr {$wtext+[image width $img]+4}]
+            set himg  [expr {[image height $img]+6}]
+            if { $himg > $hmax } {
+                set hmax $himg
+            }
+        }
+        set  wmax  [expr {$wtext>$wmax ? $wtext : $wmax}]
+        incr wtot  $wtext
+        set  data($page,width) $wtext
+    }
+    if { [Widget::getoption $path -homogeneous] } {
+        foreach page $data(pages) {
+            set data($page,width) $wmax
+        }
+        set wtot [expr {$wmax * [llength $data(pages)]}]
+    }
+    set data(hpage) $hmax
+    set data(wpage) $wtot
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command NoteBook::_get_x_page
+# ------------------------------------------------------------------------------
+proc NoteBook::_get_x_page { path pos } {
+    variable _warrow
+    variable $path
+    upvar 0  $path data
+
+    set base $data(base)
+    set x    [expr {$_warrow+1}]
+    if { $pos < $base } {
+        foreach page [lrange $data(pages) $pos [expr {$base-1}]] {
+            incr x [expr {-$data($page,width)}]
+        }
+    } elseif { $pos > $base } {
+        foreach page [lrange $data(pages) $base [expr {$pos-1}]] {
+            incr x $data($page,width)
+        }
+    }
+    return $x
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command NoteBook::_xview
+# ------------------------------------------------------------------------------
+proc NoteBook::_xview { path inc } {
+    variable $path
+    upvar 0  $path data
+
+    if { $inc == -1 } {
+        set base [expr {$data(base)-1}]
+        set dx $data([lindex $data(pages) $base],width)
+    } else {
+        set dx [expr {-$data([lindex $data(pages) $data(base)],width)}]
+        set base [expr {$data(base)+1}]
+    }
+
+    if { $base >= 0 && $base < [llength $data(pages)] } {
+        set data(base) $base
+        $path:cmd move page $dx 0
+        _draw_area   $path
+        _draw_arrows $path
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command NoteBook::_highlight
+# ------------------------------------------------------------------------------
+proc NoteBook::_highlight { type path page } {
+    variable $path
+    upvar 0  $path data
+
+    if { ![string compare [Widget::getoption $path.f$page -state] "disabled"] } {
+        return
+    }
+
+    switch -- $type {
+        on {
+            $path:cmd itemconfigure "$page:poly" -fill [Widget::getoption $path -activebackground]
+            $path:cmd itemconfigure "$page:text" -fill [Widget::getoption $path -activeforeground]
+        }
+        off {
+            $path:cmd itemconfigure "$page:poly" -fill [Widget::getoption $path -background]
+            $path:cmd itemconfigure "$page:text" -fill [Widget::getoption $path -foreground]
+        }
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command NoteBook::_select
+# ------------------------------------------------------------------------------
+proc NoteBook::_select { path page } {
+    variable $path
+    upvar 0  $path data
+
+    if { ![string compare [Widget::getoption $path.f$page -state] "normal"] } {
+        set oldsel $data(select)
+        if { [string compare $page $oldsel] } {
+            if { $oldsel != "" } {
+                if { [set cmd [Widget::getoption $path.f$oldsel -leavecmd]] != "" } {
+                    if { [set code [catch {uplevel \#0 $cmd} res]] == 1 || $res == 0 } {
+                        return -code $code $res
+                    }
+                }
+                set data(select) ""
+                _draw_page $path $oldsel 0
+            }
+            set data(select) $page
+            if { $page != "" } {
+                if { !$data($page,realized) } {
+                    set data($page,realized) 1
+                    if { [set cmd [Widget::getoption $path.f$page -createcmd]] != "" } {
+                        uplevel \#0 $cmd
+                    }
+                }
+                if { [set cmd [Widget::getoption $path.f$page -raisecmd]] != "" } {
+                    uplevel \#0 $cmd
+                }
+                _draw_page $path $page 0
+            }
+            _draw_area $path
+        }
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command NoteBook::_redraw
+# ------------------------------------------------------------------------------
+proc NoteBook::_redraw { path } {
+    variable $path
+    upvar 0  $path data
+
+    if { !$data(realized) } {
+        return
+    }
+
+    foreach page $data(pages) {
+        _draw_page $path $page 0
+    }
+    _draw_area   $path
+    _draw_arrows $path
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command NoteBook::_draw_page
+# ------------------------------------------------------------------------------
+proc NoteBook::_draw_page { path page create } {
+    variable $path
+    upvar 0  $path data
+
+    # --- calcul des coordonnees et des couleurs de l'onglet ---------------------------------
+    set pos [lsearch $data(pages) $page]
+    set bg  [Widget::getoption $path -background]
+    set h   $data(hpage)
+    set xd  [_get_x_page $path $pos]
+    set xf  [expr {$xd + $data($page,width)}]
+    set lt  [list $xd $h $xd 4 [expr {$xd+3}] 1 $xf 1]
+    set lb  [list $xf 1 [expr {$xf+3}] 4 [expr {$xf+3}] [expr {$h-3}] [expr {$xf+6}] $h]
+    set img [Widget::getoption $path.f$page -image]
+    if { $data(select) == $page } {
+        set fgt   $data(lbg)
+        set fgb   $data(dbg)
+        set ytext [expr {$h/2-1}]
+        if { $img == "" } {
+            set xtext [expr {$xd+9}]
+        } else {
+            set ximg  [expr {$xd+9}]
+            set xtext [expr {$ximg+[image width $img]+4}]
+        }
+        set bd    [Widget::getoption $path -borderwidth]
+        set fg    [Widget::getoption $path -foreground]
+    } else {
+        set fgt   $data(dbg)
+        set fgb   $fgt
+        set ytext [expr {$h/2}]
+        if { $img == "" } {
+            set xtext [expr {$xd+10}]
+        } else {
+            set ximg  [expr {$xd+10}]
+            set xtext [expr {$ximg+[image width $img]+4}]
+        }
+        set bd    1
+        if { [Widget::getoption $path.f$page -state] == "normal" } {
+            set fg [Widget::getoption $path -foreground]
+        } else {
+            set fg [Widget::getoption $path -disabledforeground]
+        }
+    }
+
+    # --- creation ou modification de l'onglet -----------------------------------------------
+    if { $create } {
+        eval $path:cmd create polygon [concat $lt $lb] \
+            -tag     {"page p:$page $page:poly"} \
+            -outline $bg \
+            -fill    $bg
+        eval $path:cmd create line $lt -tags {"page p:$page $page:top top"} -fill $fgt -width $bd
+        eval $path:cmd create line $lb -tags {"page p:$page $page:bot bot"} -fill $fgb -width $bd
+        $path:cmd create text $xtext $ytext           \
+            -text   [Widget::getoption $path.f$page -text] \
+            -font   [Widget::getoption $path -font]        \
+            -fill   $fg                               \
+            -anchor w                                 \
+            -tags   "page p:$page $page:text"
+
+        $path:cmd bind p:$page <ButtonPress-1> "NoteBook::_select $path $page"
+        $path:cmd bind p:$page <Enter>         "NoteBook::_highlight on  $path $page"
+        $path:cmd bind p:$page <Leave>         "NoteBook::_highlight off $path $page"
+    } else {
+        eval $path:cmd coords "$page:poly" [concat $lt $lb]
+        eval $path:cmd coords "$page:top"  $lt
+        eval $path:cmd coords "$page:bot"  $lb
+        $path:cmd coords "$page:text" $xtext $ytext
+
+        $path:cmd itemconfigure "$page:poly" -fill $bg  -outline $bg
+        $path:cmd itemconfigure "$page:top"  -fill $fgt -width $bd
+        $path:cmd itemconfigure "$page:bot"  -fill $fgb -width $bd
+        $path:cmd itemconfigure "$page:text"    \
+            -text [Widget::getoption $path.f$page -text]     \
+            -font [Widget::getoption $path -font]    \
+            -fill $fg
+    }
+    if { $img != "" } {
+        if { [set id [$path:cmd find withtag $page:img]] == "" } {
+            $path:cmd create image $ximg $ytext \
+                -image  $img \
+                -anchor w    \
+                -tags   "page p:$page $page:img"
+        } else {
+            $path:cmd coords $id $ximg $ytext
+            $path:cmd itemconfigure $id -image $img
+        }
+    } else {
+        $path:cmd delete $page:img
+    }
+
+    if { $data(select) == $page } {
+        $path:cmd raise p:$page
+    } elseif { $pos == 0 } {
+        if { $data(select) == "" } {
+            $path:cmd raise p:$page
+        } else {
+            $path:cmd lower p:$page p:$data(select)
+        }
+    } else {
+        set pred [lindex $data(pages) [expr {$pos-1}]]
+        if { $data(select) != $pred || $pos == 1 } {
+            $path:cmd lower p:$page p:$pred
+        } else {
+            $path:cmd lower p:$page p:[lindex $data(pages) [expr {$pos-2}]]
+        }
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command NoteBook::_draw_arrows
+# ------------------------------------------------------------------------------
+proc NoteBook::_draw_arrows { path } {
+    variable _warrow
+    variable $path
+    upvar 0  $path data
+
+    set w       [expr {[winfo width $path]-1}]
+    set h       [expr {$data(hpage)-1}]
+    set nbpages [llength $data(pages)]
+    set xl      0
+    set xr      [expr {$w-$_warrow+1}]
+
+    if { $data(base) > 0 } {
+        if { ![llength [$path:cmd find withtag "leftarrow"]] } {
+            $path:cmd create window $xl 1 \
+                -width  $_warrow          \
+                -height $h                \
+                -anchor nw                \
+                -window $path.fg          \
+                -tags   "leftarrow"
+        } else {
+            $path:cmd coords "leftarrow" $xl 1
+            $path:cmd itemconfigure "leftarrow" -width $_warrow -height $h
+        }
+    } else {
+        $path:cmd delete "leftarrow"
+    }
+
+    if { $data(base) < $nbpages-1 &&
+         $data(wpage) + [_get_x_page $path 0] + 6 > $w } {
+        if { ![llength [$path:cmd find withtag "rightarrow"]] } {
+            $path:cmd create window $xr 1 \
+                -width  $_warrow          \
+                -height $h                \
+                -window $path.fd          \
+                -anchor nw                \
+                -tags   "rightarrow"
+        } else {
+            $path:cmd coords "rightarrow" $xr 1
+            $path:cmd itemconfigure "rightarrow" -width $_warrow -height $h
+        }
+    } else {
+        $path:cmd delete "rightarrow"
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command NoteBook::_draw_area
+# ------------------------------------------------------------------------------
+proc NoteBook::_draw_area { path } {
+    variable $path
+    upvar 0  $path data
+
+    set w   [expr {[winfo width  $path]-1}]
+    set h   [expr {[winfo height $path]-1}]
+    set bd  [Widget::getoption $path -borderwidth]
+    set x0  [expr {$bd-1}]
+    set y0  $data(hpage)
+    set y1  $h
+    set dbg $data(dbg)
+    set sel $data(select)
+    if {  $sel == "" } {
+        set xd  [expr {$w/2}]
+        set xf  $xd
+        set lbg $data(dbg)
+    } else {
+        set xd [_get_x_page $path [lsearch $data(pages) $data(select)]]
+        set xf [expr {$xd + $data($sel,width)+6}]
+        set lbg $data(lbg)
+    }
+
+    if { [llength [$path:cmd find withtag rect]] } {
+        $path:cmd coords "toprect1" $xd $y0 $x0 $y0 $x0 $h
+        $path:cmd coords "toprect2" $w $y0 $xf $y0
+        $path:cmd coords "botrect"  $x0 $h $w $h $w $y0
+        $path:cmd itemconfigure "toprect1" -fill $lbg -width $bd
+        $path:cmd itemconfigure "toprect2" -fill $lbg -width $bd
+        $path:cmd itemconfigure "botrect"  -width $bd
+        $path:cmd raise "rect"
+    } else {
+        $path:cmd create line $xd $y0 $x0 $y0 $x0 $y1 \
+            -tags "rect toprect1" -fill $lbg -width $bd
+        $path:cmd create line $w $y0 $xf $y0 \
+            -tags "rect toprect2" -fill $lbg -width $bd
+        $path:cmd create line 1 $h $w $h $w $y0 \
+            -tags "rect botrect"  -fill $dbg -width $bd
+    }
+
+    if { $sel != "" } {
+        if { [llength [$path:cmd find withtag "window"]] } {
+            $path:cmd coords "window" 2 [expr {$y0+1}]
+            $path:cmd itemconfigure "window"    \
+                -width  [expr {$w-3}]        \
+                -height [expr {$h-$y0-3}]    \
+                -window $path.f$sel
+        } else {
+            set y0 $data(hpage)
+            $path:cmd create window 2 [expr {$y0+1}] \
+                -width  [expr {$w-3}]           \
+                -height [expr {$h-$y0-3}]       \
+                -anchor nw                      \
+                -tags   "window"                \
+                -window $path.f$sel
+        }
+    } else {
+        $path:cmd delete "window"
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command NoteBook::_resize
+# ------------------------------------------------------------------------------
+proc NoteBook::_resize { path } {
+    _draw_area   $path
+    _draw_arrows $path
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command NoteBook::_realize
+# ------------------------------------------------------------------------------
+proc NoteBook::_realize { path } {
+    variable $path
+    upvar 0  $path data
+
+    if { [set width  [Widget::getoption $path -width]]  == 0 ||
+         [set height [Widget::getoption $path -height]] == 0 } {
+        compute_size $path
+    }
+
+    set data(realized) 1
+    _draw_area $path
+    _draw_arrows $path
+    bind $path <Configure> "NoteBook::_resize $path"
+}

lib/external/bwidget/pagesmgr.tcl

@@ -0,0 +1,298 @@
+# ------------------------------------------------------------------------------
+#  pagesmgr.tcl
+#  This file is part of Unifix BWidget Toolkit
+#  $Id$
+# ------------------------------------------------------------------------------
+#  Index of commands:
+#     - PagesManager::create
+#     - PagesManager::configure
+#     - PagesManager::cget
+#     - PagesManager::compute_size
+#     - PagesManager::add
+#     - PagesManager::delete
+#     - PagesManager::raise
+#     - PagesManager::page
+#     - PagesManager::pages
+#     - PagesManager::getframe
+#     - PagesManager::_test_page
+#     - PagesManager::_select
+#     - PagesManager::_redraw
+#     - PagesManager::_draw_area
+#     - PagesManager::_realize
+# ------------------------------------------------------------------------------
+
+namespace eval PagesManager {
+    Widget::declare PagesManager {
+        {-background TkResource "" 0 frame}
+        {-width      Int        0  0 {=0 ""}}
+        {-height     Int        0  0 {=0 ""}}
+    }
+
+    Widget::addmap PagesManager "" :cmd {-width {} -height {}}
+
+    proc ::PagesManager { path args } { return [eval PagesManager::create $path $args] }
+    proc use {} {}
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command PagesManager::create
+# ------------------------------------------------------------------------------
+proc PagesManager::create { path args } {
+    variable $path
+    upvar 0  $path data
+
+    Widget::init PagesManager $path $args
+
+    set data(select)   ""
+    set data(pages)    {}
+    set data(cpt)      0
+    set data(realized) 0
+
+    # --- creation du canvas -----------------------------------------------------------------
+    set w [Widget::cget $path -width]
+    set h [Widget::cget $path -height]
+    canvas $path -relief flat -bd 0 -highlightthickness 0 -width $w -height $h
+
+    bind $path <Configure> "PagesManager::_realize $path"
+    bind $path <Destroy>   "PagesManager::_destroy $path"
+
+    rename $path ::$path:cmd
+    proc ::$path { cmd args } "return \[eval PagesManager::\$cmd $path \$args\]"
+
+    return $path
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command PagesManager::configure
+# ------------------------------------------------------------------------------
+proc PagesManager::configure { path args } {
+    return [Widget::configure $path $args]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command PagesManager::cget
+# ------------------------------------------------------------------------------
+proc PagesManager::cget { path option } {
+    return [Widget::cget $path $option]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command PagesManager::compute_size
+# ------------------------------------------------------------------------------
+proc PagesManager::compute_size { path } {
+    variable $path
+    upvar 0  $path data
+
+    set wmax 0
+    set hmax 0
+    update idletasks
+    foreach page $data(pages) {
+        set w    [winfo reqwidth  $path.f$page]
+        set h    [winfo reqheight $path.f$page]
+        set wmax [expr {$w>$wmax ? $w : $wmax}]
+        set hmax [expr {$h>$hmax ? $h : $hmax}]
+    }
+    configure $path -width $wmax -height $hmax
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command PagesManager::add
+# ------------------------------------------------------------------------------
+proc PagesManager::add { path page } {
+    variable $path
+    upvar 0  $path data
+
+    if { [lsearch $data(pages) $page] != -1 } {
+        return -code error "page \"$page\" already exists"
+    }
+
+    lappend data(pages) $page
+
+    frame $path.f$page -relief flat -background [Widget::cget $path -background] -borderwidth 0
+
+    return $path.f$page
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command PagesManager::delete
+# ------------------------------------------------------------------------------
+proc PagesManager::delete { path page } {
+    variable $path
+    upvar 0  $path data
+
+    set pos [_test_page $path $page]
+    set data(pages) [lreplace $data(pages) $pos $pos]
+    if { $data(select) == $page } {
+        set data(select) ""
+    }
+    destroy $path.f$page
+    _redraw $path
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command PagesManager::raise
+# ------------------------------------------------------------------------------
+proc PagesManager::raise { path {page ""} } {
+    variable $path
+    upvar 0  $path data
+
+    if { $page != "" } {
+        _test_page $path $page
+        _select $path $page
+    }
+    return $data(select)
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command PagesManager::page - deprecated, use pages
+# ------------------------------------------------------------------------------
+proc PagesManager::page { path first {last ""} } {
+    variable $path
+    upvar 0  $path data
+
+    if { $last == "" } {
+        return [lindex $data(pages) $first]
+    } else {
+        return [lrange $data(pages) $first $last]
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command PagesManager::pages
+# ------------------------------------------------------------------------------
+proc PagesManager::pages { path {first ""} {last ""} } {
+    variable $path
+    upvar 0  $path data
+
+    if { ![string length $first] } {
+	return $data(pages)
+    }
+
+    if { ![string length $last] } {
+        return [lindex $data(pages) $first]
+    } else {
+        return [lrange $data(pages) $first $last]
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command PagesManager::_destroy
+# ------------------------------------------------------------------------------
+proc PagesManager::_destroy { path } {
+    variable $path
+    upvar 0  $path data
+
+    Widget::destroy $path
+    unset data
+    rename $path {}
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command PagesManager::getframe
+# ------------------------------------------------------------------------------
+proc PagesManager::getframe { path page } {
+    return $path.f$page
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command PagesManager::_test_page
+# ------------------------------------------------------------------------------
+proc PagesManager::_test_page { path page } {
+    variable $path
+    upvar 0  $path data
+
+    if { [set pos [lsearch $data(pages) $page]] == -1 } {
+        return -code error "page \"$page\" does not exists"
+    }
+    return $pos
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command PagesManager::_select
+# ------------------------------------------------------------------------------
+proc PagesManager::_select { path page } {
+    variable $path
+    upvar 0  $path data
+
+    set oldsel $data(select)
+    if { $page != $oldsel } {
+        set data(select) $page
+        _draw_area $path
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command PagesManager::_redraw
+# ------------------------------------------------------------------------------
+proc PagesManager::_redraw { path } {
+    variable $path
+    upvar 0  $path data
+
+    if { !$data(realized) } {
+        return
+    }
+    _draw_area $path
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command PagesManager::_draw_area
+# ------------------------------------------------------------------------------
+proc PagesManager::_draw_area { path } {
+    variable $path
+    upvar 0  $path data
+
+    set w   [winfo width  $path]
+    set h   [winfo height $path]
+    set sel $data(select)
+    if { $sel != "" } {
+        if { [llength [$path:cmd find withtag "window"]] } {
+            $path:cmd coords "window" 0 0
+            $path:cmd itemconfigure "window"    \
+                -width  $w        \
+                -height $h    \
+                -window $path.f$sel
+        } else {
+            $path:cmd create window 0 0 \
+                -width  $w          \
+                -height $h       \
+                -anchor nw                      \
+                -tags   "window"                \
+                -window $path.f$sel
+        }
+    } else {
+        $path:cmd delete "window"
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command PagesManager::_realize
+# ------------------------------------------------------------------------------
+proc PagesManager::_realize { path } {
+    variable $path
+    upvar 0  $path data
+
+    if { [set width  [Widget::cget $path -width]]  == 0 ||
+         [set height [Widget::cget $path -height]] == 0 } {
+        compute_size $path
+    }
+
+    set data(realized) 1
+    _draw_area $path
+    bind $path <Configure> "PagesManager::_draw_area $path"
+}

lib/external/bwidget/panedw.tcl

@@ -0,0 +1,303 @@
+# ------------------------------------------------------------------------------
+#  panedw.tcl
+#  This file is part of Unifix BWidget Toolkit
+# ------------------------------------------------------------------------------
+#  Index of commands:
+#     - PanedWindow::create
+#     - PanedWindow::configure
+#     - PanedWindow::cget
+#     - PanedWindow::add
+#     - PanedWindow::getframe
+#     - PanedWindow::_destroy
+#     - PanedWindow::_beg_move_sash
+#     - PanedWindow::_move_sash
+#     - PanedWindow::_end_move_sash
+#     - PanedWindow::_realize
+# ------------------------------------------------------------------------------
+
+namespace eval PanedWindow {
+    namespace eval Pane {
+        Widget::declare PanedWindow::Pane {
+            {-minsize Int 0 0 {=0}}
+            {-weight  Int 1 0 {=0}}
+        }
+    }
+
+    Widget::declare PanedWindow {
+        {-side       Enum       top 1 {top left bottom right}}
+        {-width      Int        10  1 {=6 ""}}
+        {-pad        Int        4   1 {=0 ""}}
+        {-background TkResource ""  0 frame}
+        {-bg         Synonym    -background}
+    }
+
+    variable _panedw
+
+    proc ::PanedWindow { path args } { return [eval PanedWindow::create $path $args] }
+    proc use {} {}
+}
+
+
+
+# ------------------------------------------------------------------------------
+#  Command PanedWindow::create
+# ------------------------------------------------------------------------------
+proc PanedWindow::create { path args } {
+    variable _panedw
+
+    Widget::init PanedWindow $path $args
+
+    frame $path -background [Widget::getoption $path -background]
+    set _panedw($path,nbpanes) 0
+
+    bind $path <Configure> "PanedWindow::_realize $path %w %h"
+    bind $path <Destroy>   "PanedWindow::_destroy $path"
+
+    rename $path ::$path:cmd
+    proc ::$path { cmd args } "return \[eval PanedWindow::\$cmd $path \$args\]"
+
+    return $path
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command PanedWindow::configure
+# ------------------------------------------------------------------------------
+proc PanedWindow::configure { path args } {
+    variable _panedw
+
+    set res [Widget::configure $path $args]
+
+    if { [Widget::hasChanged $path -background bg] && $_panedw($path,nbpanes) > 0 } {
+        $path:cmd configure -background $bg
+        $path.f0 configure -background $bg
+        for {set i 1} {$i < $_panedw($path,nbpanes)} {incr i} {
+            set frame $path.sash$i
+            $frame configure -background $bg
+            $frame.sep configure -background $bg
+            $frame.but configure -background $bg
+            $path.f$i configure -background $bg
+            $path.f$i.frame configure -background $bg
+        }
+    }
+    return $res
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command PanedWindow::cget
+# ------------------------------------------------------------------------------
+proc PanedWindow::cget { path option } {
+    return [Widget::cget $path $option]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command PanedWindow::add
+# ------------------------------------------------------------------------------
+proc PanedWindow::add { path args } {
+    variable _panedw
+
+    set num $_panedw($path,nbpanes)
+    Widget::init PanedWindow::Pane $path.f$num $args
+    set bg [Widget::getoption $path -background]
+
+    set wbut  [Widget::getoption $path -width]
+    set pad   [Widget::getoption $path -pad]
+    set width [expr {$wbut+2*$pad}]
+    set side  [Widget::getoption $path -side]
+    if { $num > 0 } {
+        set frame [frame $path.sash$num -relief flat -bd 0 -highlightthickness 0 \
+                       -width $width -height $width -bg $bg]
+        set sep   [frame $frame.sep -bd 1 -relief raised -highlightthickness 0 -bg $bg]
+        set but   [frame $frame.but -bd 1 -relief raised -highlightthickness 0 -bg $bg \
+                       -width $wbut -height $wbut]
+        if { ![string compare $side "top"] || ![string compare $side "bottom"] } {
+            place $sep -relx 0.5 -y 0 -width 2 -relheight 1.0 -anchor n
+            if { ![string compare $side "top"] } {
+                place $but -relx 0.5 -y [expr {6+$wbut/2}] -anchor c
+            } else {
+                place $but -relx 0.5 -rely 1.0 -y [expr {-6-$wbut/2}] -anchor c
+            }
+            $but configure -cursor sb_h_double_arrow 
+            grid $frame -column [expr 2*$num-1] -row 0 -sticky ns
+            grid columnconfigure $path [expr 2*$num-1] -weight 0
+        } else {
+            place $sep -x 0 -rely 0.5 -height 2 -relwidth 1.0 -anchor w
+            if { ![string compare $side "left"] } {
+                place $but -rely 0.5 -x [expr {6+$wbut/2}] -anchor c
+            } else {
+                place $but -rely 0.5 -relx 1.0 -x [expr {-6-$wbut/2}] -anchor c
+            }
+            $but configure -cursor sb_v_double_arrow 
+            grid $frame -row [expr 2*$num-1] -column 0 -sticky ew
+            grid rowconfigure $path [expr 2*$num-1] -weight 0
+        }
+        bind $but <ButtonPress-1> "PanedWindow::_beg_move_sash $path $num %X %Y"
+    } else {
+        if { ![string compare $side "top"] || ![string compare $side "bottom"] } {
+            grid rowconfigure $path 0 -weight 1
+        } else {
+            grid columnconfigure $path 0 -weight 1
+        }
+    }
+
+    set pane [frame $path.f$num -bd 0 -relief flat -highlightthickness 0 -bg $bg]
+    set user [frame $path.f$num.frame  -bd 0 -relief flat -highlightthickness 0 -bg $bg]
+    if { ![string compare $side "top"] || ![string compare $side "bottom"] } {
+        grid $pane -column [expr 2*$num] -row 0 -sticky nsew
+        grid columnconfigure $path [expr 2*$num] \
+            -weight  [Widget::getoption $path.f$num -weight]
+    } else {
+        grid $pane -row [expr 2*$num] -column 0 -sticky nsew
+        grid rowconfigure $path [expr 2*$num] \
+            -weight  [Widget::getoption $path.f$num -weight]
+    }
+    pack $user -fill both -expand yes
+    incr _panedw($path,nbpanes)
+
+    return $user
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command PanedWindow::getframe
+# ------------------------------------------------------------------------------
+proc PanedWindow::getframe { path index } {
+    if { [winfo exists $path.f$index.frame] } {
+        return $path.f$index.frame
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command PanedWindow::_destroy
+# ------------------------------------------------------------------------------
+proc PanedWindow::_destroy { path } {
+    variable _panedw
+
+    for {set i 0} {$i < $_panedw($path,nbpanes)} {incr i} {
+        Widget::destroy $path.f$i
+    }
+    unset _panedw($path,nbpanes)
+    Widget::destroy $path
+    rename $path {}
+}
+    
+
+# ------------------------------------------------------------------------------
+#  Command PanedWindow::_beg_move_sash
+# ------------------------------------------------------------------------------
+proc PanedWindow::_beg_move_sash { path num x y } {
+    variable _panedw
+
+    set fprev $path.f[expr $num-1]
+    set fnext $path.f$num
+    set wsash [expr [Widget::getoption $path -width] + 2*[Widget::getoption $path -pad]]
+
+    $path.sash$num.but configure -relief sunken
+    set top  [toplevel $path.sash -borderwidth 1 -relief raised]
+
+    set minszg [Widget::getoption $fprev -minsize]
+    set minszd [Widget::getoption $fnext -minsize]
+    set side   [Widget::getoption $path -side]
+
+    if { ![string compare $side "top"] || ![string compare $side "bottom"] } {
+        $top configure -cursor sb_h_double_arrow
+        set h    [winfo height $path]
+        set yr   [winfo rooty $path.sash$num]
+        set xmin [expr $wsash/2+[winfo rootx $fprev]+$minszg]
+        set xmax [expr -$wsash/2-1+[winfo rootx $fnext]+[winfo width $fnext]-$minszd]
+        wm overrideredirect $top 1
+        wm geom $top "2x${h}+$x+$yr"
+
+        update idletasks
+        grab set $top
+        bind $top <ButtonRelease-1> "PanedWindow::_end_move_sash $path $top $num $xmin $xmax %X rootx width"
+        bind $top <Motion>          "PanedWindow::_move_sash $top $xmin $xmax %X +%%d+$yr"
+        _move_sash $top $xmin $xmax $x "+%d+$yr"
+    } else {
+        $top configure -cursor sb_v_double_arrow
+        set w    [winfo width $path]
+        set xr   [winfo rootx $path.sash$num]
+        set ymin [expr $wsash/2+[winfo rooty $fprev]+$minszg]
+        set ymax [expr -$wsash/2-1+[winfo rooty $fnext]+[winfo height $fnext]-$minszd]
+        wm overrideredirect $top 1
+        wm geom $top "${w}x2+$xr+$y"
+
+        update idletasks
+        grab set $top
+        bind $top <ButtonRelease-1> "PanedWindow::_end_move_sash $path $top $num $ymin $ymax %Y rooty height"
+        bind $top <Motion>          "PanedWindow::_move_sash $top $ymin $ymax %Y +$xr+%%d"
+        _move_sash $top $ymin $ymax $y "+$xr+%d"
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command PanedWindow::_move_sash
+# ------------------------------------------------------------------------------
+proc PanedWindow::_move_sash { top min max v form } {
+
+    if { $v < $min } {
+	set v $min
+    } elseif { $v > $max } {
+	set v $max
+    }
+    wm geom $top [format $form $v]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command PanedWindow::_end_move_sash
+# ------------------------------------------------------------------------------
+proc PanedWindow::_end_move_sash { path top num min max v rootv size } {
+    variable _panedw
+
+    destroy $top
+    if { $v < $min } {
+	set v $min
+    } elseif { $v > $max } {
+	set v $max
+    }
+    set fprev $path.f[expr $num-1]
+    set fnext $path.f$num
+
+    $path.sash$num.but configure -relief raised
+
+    set wsash [expr [Widget::getoption $path -width] + 2*[Widget::getoption $path -pad]]
+    set dv    [expr $v-[winfo $rootv $path.sash$num]-$wsash/2]
+    set w1    [winfo $size $fprev]
+    set w2    [winfo $size $fnext]
+
+    for {set i 0} {$i < $_panedw($path,nbpanes)} {incr i} {
+        if { $i == $num-1} {
+            $fprev configure -$size [expr [winfo $size $fprev]+$dv]
+        } elseif { $i == $num } {
+            $fnext configure -$size [expr [winfo $size $fnext]-$dv]
+        } else {
+            $path.f$i configure -$size [winfo $size $path.f$i]
+        }
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command PanedWindow::_realize
+# ------------------------------------------------------------------------------
+proc PanedWindow::_realize { path width height } {
+    variable _panedw
+
+    set x    0
+    set y    0
+    set hc   [winfo reqheight $path]
+    set hmax 0
+    for {set i 0} {$i < $_panedw($path,nbpanes)} {incr i} {
+        $path.f$i configure \
+            -width  [winfo reqwidth  $path.f$i.frame] \
+            -height [winfo reqheight $path.f$i.frame]
+        place $path.f$i.frame -x 0 -y 0 -relwidth 1 -relheight 1
+    }
+
+    bind $path <Configure> {}
+}

lib/external/bwidget/passwddlg.tcl

@@ -0,0 +1,176 @@
+# -----------------------------------------------------------------------------
+#  passwddlg.tcl
+#  This file is part of Unifix BWidget Toolkit
+#   by Stephane Lavirotte (Stephane.Lavirotte@sophia.inria.fr)
+#  $Id$
+# -----------------------------------------------------------------------------
+#  Index of commands:
+#     - PasswdDlg::create
+#     - PasswdDlg::configure
+#     - PasswdDlg::cget
+#     - PasswdDlg::_verifonlogin
+#     - PasswdDlg::_verifonpasswd
+#     - PasswdDlg::_max
+#------------------------------------------------------------------------------
+
+namespace eval PasswdDlg {
+    Dialog::use
+    LabelEntry::use
+
+    Widget::bwinclude PasswdDlg Dialog "" \
+        remove     {-image -bitmap -side -default -cancel -separator} \
+        initialize {-modal local -anchor c}
+
+    Widget::bwinclude PasswdDlg LabelEntry .frame.lablog \
+        remove {
+            -command -editable -justify -name -show -side -state -takefocus
+            -width -xscrollcommand -padx -pady
+            -dragenabled -dragendcmd -dragevent -draginitcmd -dragtype
+            -dropenabled -dropcmd -dropovercmd -droptypes
+        } \
+        prefix     {login -helptext -helpvar -label -text -textvariable -underline} \
+        initialize {-relief sunken -borderwidth 2 -labelanchor w -width 15 -loginlabel "Login"}
+
+    Widget::bwinclude PasswdDlg LabelEntry .frame.labpass \
+        remove {
+            -command -width -show -side -takefocus -xscrollcommand
+            -dragenabled -dragendcmd -dragevent -draginitcmd -dragtype
+            -dropenabled -dropcmd -dropovercmd -droptypes -justify -padx -pady -name
+        } \
+        prefix {passwd -editable -helptext -helpvar -label -state -text -textvariable -underline} \
+        initialize {-relief sunken -borderwidth 2 -labelanchor w -width 15 -passwdlabel "Password"}
+
+    Widget::declare PasswdDlg {
+        {-type        Enum       ok           0 {ok okcancel}}
+        {-labelwidth  TkResource -1           0 {label -width}}
+        {-command     String     ""           0}
+    }
+
+    Widget::syncoptions PasswdDlg LabelEntry .frame.lablog  {
+        -logintext -text -loginlabel -label -loginunderline -underline
+    }
+    Widget::syncoptions PasswdDlg LabelEntry .frame.labpass {
+        -passwdtext -text -passwdlabel -label -passwdunderline -underline
+    }
+
+    proc ::PasswdDlg { path args } { return [eval PasswdDlg::create $path $args] }
+    proc use {} {}
+}
+
+
+# -----------------------------------------------------------------------------
+#  Command PasswdDlg::create
+# -----------------------------------------------------------------------------
+proc PasswdDlg::create { path args } {
+
+    Widget::init PasswdDlg "$path#PasswdDlg" $args
+    set type      [Widget::getoption "$path#PasswdDlg" -type]
+    set loglabel  [Widget::getoption "$path#PasswdDlg" -loginlabel]
+    set passlabel [Widget::getoption "$path#PasswdDlg" -passwdlabel]
+    set labwidth  [Widget::getoption "$path#PasswdDlg" -labelwidth]
+    set cmd       [Widget::getoption "$path#PasswdDlg" -command]
+
+    set defb -1
+    set canb -1
+    switch -- $type {
+        ok        { set lbut {ok}; set defb 0 }
+        okcancel  { set lbut {ok cancel} ; set defb 0; set canb 1 }
+    }
+
+    eval Dialog::create $path [Widget::subcget "$path#PasswdDlg" ""] \
+        -image [Bitmap::get passwd] -side bottom -default $defb -cancel $canb
+    foreach but $lbut {
+        if { $but == "ok" && $cmd != "" } {
+            Dialog::add $path -text $but -name $but -command $cmd
+        } else {
+            Dialog::add $path -text $but -name $but
+        }
+    }
+    set frame [Dialog::getframe $path]
+    bind $path  <Return>  ""
+    bind $frame <Destroy> "Widget::destroy $path#PasswdDlg"
+
+    set lablog [eval LabelEntry::create $frame.lablog \
+                    [Widget::subcget "$path#PasswdDlg" .frame.lablog] \
+                    -label \"$loglabel\" -name login \
+                    -dragenabled 0 -dropenabled 0 \
+                    -command \"PasswdDlg::_verifonpasswd $path $frame.labpass\"]
+
+    set labpass [eval LabelEntry::create $frame.labpass \
+                     [Widget::subcget "$path#PasswdDlg" .frame.labpass] \
+                     -label \"$passlabel\" -name password -show "*" \
+                     -dragenabled 0 -dropenabled 0 \
+                     -command \"PasswdDlg::_verifonlogin $path $frame.lablog\"]
+
+    if { $labwidth == -1 } {
+        # les options -label sont mises a jour selon -name
+        set loglabel  [$lablog cget -label]
+        set passlabel [$labpass cget -label]
+        set labwidth  [PasswdDlg::_max [string length $loglabel] [string length $passlabel]]
+        incr labwidth 1
+        $lablog  configure -labelwidth $labwidth
+        $labpass configure -labelwidth $labwidth
+    }
+
+    proc ::$path { cmd args } "return \[eval PasswdDlg::\$cmd $path \$args\]"
+
+    pack  $frame.lablog $frame.labpass -fill x -expand 1
+    focus $frame.lablog.e
+    set res [Dialog::draw $path]
+
+    if { $res == 0 } {
+        set res [list [$lablog.e cget -text] [$labpass.e cget -text]]
+    } else {
+        set res [list]
+    }
+    Widget::destroy "$path#PasswdDlg"
+    destroy $path
+
+    return $res
+}
+
+# -----------------------------------------------------------------------------
+#  Command PasswdDlg::configure
+# -----------------------------------------------------------------------------
+
+proc PasswdDlg::configure { path args } {
+    set res [Widget::configure "$path#PasswdDlg" $args]
+}
+
+# -----------------------------------------------------------------------------
+#  Command PasswdDlg::cget
+# -----------------------------------------------------------------------------
+
+proc PasswdDlg::cget { path option } {
+    return [Widget::cget "$path#PasswdDlg" $option]
+}
+
+
+# -----------------------------------------------------------------------------
+#  Command PasswdDlg::_verifonlogin
+# -----------------------------------------------------------------------------
+proc PasswdDlg::_verifonlogin { path labpass } {
+    if { [$labpass.e cget -text] == "" } {
+        focus $labpass
+    } else {
+        Dialog::setfocus $path default
+    }
+}
+
+# -----------------------------------------------------------------------------
+#  Command PasswdDlg::_verifonpasswd
+# -----------------------------------------------------------------------------
+proc PasswdDlg::_verifonpasswd { path lablog } {
+    if { [$lablog.e cget -text] == "" } {
+        focus $lablog
+    } else {
+        Dialog::setfocus $path default
+    }
+}
+
+# -----------------------------------------------------------------------------
+#  Command PasswdDlg::_max
+# -----------------------------------------------------------------------------
+proc PasswdDlg::_max { val1 val2 } { 
+    return [expr ($val1 > $val2) ? ($val1) : ($val2)] 
+}

lib/external/bwidget/pkgIndex.tcl

@@ -0,0 +1,43 @@
+if {[catch {package require Tcl}]} return
+package ifneeded BWidget 1.2.1 "\
+    package require Tk 8.0;\
+    [list tclPkgSetup $dir BWidget 1.2.1 {
+{arrow.tcl source {ArrowButton ArrowButton::create ArrowButton::use}}
+{labelframe.tcl source {LabelFrame LabelFrame::create LabelFrame::use}}
+{labelentry.tcl source {LabelEntry LabelEntry::create LabelEntry::use}}
+{bitmap.tcl source {Bitmap::get Bitmap::use}}
+{button.tcl source {Button Button::create Button::use}}
+{buttonbox.tcl source {ButtonBox ButtonBox::create ButtonBox::use}}
+{combobox.tcl source {ComboBox ComboBox::create ComboBox::use}}
+{label.tcl source {Label Label::create Label::use}}
+{entry.tcl source {Entry Entry::create Entry::use}}
+{pagesmgr.tcl source {PagesManager PagesManager::create PagesManager::use}}
+{notebook.tcl source {NoteBook NoteBook::create NoteBook::use}}
+{panedw.tcl source {PanedWindow PanedWindow::create PanedWindow::use}}
+{scrollw.tcl source {ScrolledWindow ScrolledWindow::create ScrolledWindow::use}}
+{scrollview.tcl source {ScrollView ScrollView::create ScrollView::use}}
+{scrollframe.tcl source {ScrollableFrame ScrollableFrame::create ScrollableFrame::use}}
+{progressbar.tcl source {ProgressBar ProgressBar::create ProgressBar::use}}
+{progressdlg.tcl source {ProgressDlg ProgressDlg::create ProgressDlg::use}}
+{passwddlg.tcl source {PasswdDlg PasswdDlg::create PasswdDlg::use}}
+{dragsite.tcl source {DragSite::register DragSite::include DragSite::use}}
+{dropsite.tcl source {DropSite::register DropSite::include DropSite::use}}
+{separator.tcl source {Separator Separator::create Separator::use}}
+{spinbox.tcl source {SpinBox SpinBox::create SpinBox::use}}
+{titleframe.tcl source {TitleFrame TitleFrame::create TitleFrame::use}}
+{mainframe.tcl source {MainFrame MainFrame::create MainFrame::use}}
+{listbox.tcl source {ListBox ListBox::create ListBox::use}}
+{tree.tcl source {Tree Tree::create Tree::use}}
+{color.tcl source {SelectColor SelectColor::create SelectColor::use SelectColor::setcolor}}
+{dynhelp.tcl source {DynamicHelp::configure DynamicHelp::use DynamicHelp::register DynamicHelp::include}}
+{dialog.tcl source {Dialog Dialog::create Dialog::use}}
+{messagedlg.tcl source {MessageDlg MessageDlg::create MessageDlg::use}}
+{font.tcl source {SelectFont SelectFont::create SelectFont::use SelectFont::loadfont}}
+{widgetdoc.tcl source {Widget::generate-doc Widget::generate-widget-doc}}
+{xpm2image.tcl source {xpm-to-image}}
+}]; \
+    [list set env(BWIDGET_LIBRARY) $dir]; \
+    [list source [file join $dir widget.tcl]]; \
+    [list source [file join $dir init.tcl]]; \
+    [list source [file join $dir utils.tcl]]; \
+"

lib/external/bwidget/progressbar.tcl

@@ -0,0 +1,186 @@
+# ------------------------------------------------------------------------------
+#  progressbar.tcl
+#  This file is part of Unifix BWidget Toolkit
+# ------------------------------------------------------------------------------
+#  Index of commands:
+#     - ProgressBar::create
+#     - ProgressBar::configure
+#     - ProgressBar::cget
+#     - ProgressBar::_destroy
+#     - ProgressBar::_modify
+# ------------------------------------------------------------------------------
+
+namespace eval ProgressBar {
+    Widget::declare ProgressBar {
+        {-type        Enum       normal     0 {normal incremental infinite}}
+        {-maximum     Int        100        0 {>0}}
+        {-background  TkResource ""         0 frame}
+        {-foreground  TkResource blue       0 label}
+        {-borderwidth TkResource 2          0 frame}
+        {-troughcolor TkResource ""         0 scrollbar}
+        {-relief      TkResource sunken     0 label}
+        {-orient      Enum       horizontal 1 {horizontal vertical}}
+        {-variable    String     ""         0}
+        {-width       TkResource 100        0 frame}
+        {-height      TkResource 4m         0 frame}
+        {-bg          Synonym    -background}
+        {-fg          Synonym    -foreground}
+        {-bd          Synonym    -borderwidth}
+    }
+
+    Widget::addmap ProgressBar "" :cmd {-background {} -width {} -height {}}
+    Widget::addmap ProgressBar "" .bar {-troughcolor -background -borderwidth {} -relief {}}
+
+    variable _widget
+
+    proc ::ProgressBar { path args } { return [eval ProgressBar::create $path $args] }
+    proc use {} {}
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ProgressBar::create
+# ------------------------------------------------------------------------------
+proc ProgressBar::create { path args } {
+    variable _widget
+
+    Widget::init ProgressBar $path $args
+
+    eval frame $path [Widget::subcget $path :cmd]
+    set c  [eval canvas $path.bar [Widget::subcget $path .bar] -highlightthickness 0]
+    set fg [Widget::getoption $path -foreground]
+    if { ![string compare [Widget::getoption $path -orient] "horizontal"] } {
+        $path.bar create rectangle -1 0 0 0 -fill $fg -outline $fg -tags rect
+    } else {
+        $path.bar create rectangle 0 1 0 0 -fill $fg -outline $fg -tags rect
+    }
+
+    set _widget($path,val) 0
+    set _widget($path,dir) 1
+    if { [set _widget($path,var) [Widget::getoption $path -variable]] != "" } {
+        GlobalVar::tracevar variable $_widget($path,var) w "ProgressBar::_modify $path"
+        after idle ProgressBar::_modify $path
+    }
+
+    bind $path.bar <Destroy>   "ProgressBar::_destroy $path"
+    bind $path.bar <Configure> "ProgressBar::_modify $path"
+
+    rename $path ::$path:cmd
+    proc ::$path { cmd args } "return \[eval ProgressBar::\$cmd $path \$args\]"
+
+    return $path
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ProgressBar::configure
+# ------------------------------------------------------------------------------
+proc ProgressBar::configure { path args } {
+    variable _widget
+
+    set res [Widget::configure $path $args]
+
+    if { [Widget::hasChanged $path -variable newv] } {
+        if { $_widget($path,var) != "" } {
+            GlobalVar::tracevar vdelete $_widget($path,var) w "ProgressBar::_modify $path"
+        }
+        if { $newv != "" } {
+            set _widget($path,var) $newv
+            GlobalVar::tracevar variable $newv w "ProgressBar::_modify $path"
+            after idle ProgressBar::_modify $path
+        } else {
+            set _widget($path,var) ""
+        }
+    }
+
+    if { [Widget::hasChanged $path -borderwidth v] ||
+         [Widget::hasChanged $path -orient v] } {
+        after idle ProgressBar::_modify $path
+    }
+    if { [Widget::hasChanged $path -foreground fg] } {
+        $path.bar itemconfigure rect -fill $fg -outline $fg
+    }
+    return $res
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ProgressBar::cget
+# ------------------------------------------------------------------------------
+proc ProgressBar::cget { path option } {
+    return [Widget::cget $path $option]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ProgressBar::_destroy
+# ------------------------------------------------------------------------------
+proc ProgressBar::_destroy { path } {
+    variable _widget
+
+    if { $_widget($path,var) != "" } {
+        GlobalVar::tracevar vdelete $_widget($path,var) w "ProgressBar::_modify $path"
+    }
+    unset _widget($path,var)
+    unset _widget($path,dir)
+    Widget::destroy $path
+    rename $path {}
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ProgressBar::_modify
+# ------------------------------------------------------------------------------
+proc ProgressBar::_modify { path args } {
+    variable _widget
+
+    if { ![GlobalVar::exists $_widget($path,var)] ||
+         [set val [GlobalVar::getvar $_widget($path,var)]] < 0 } {
+        catch {place forget $path.bar}
+    } else {
+        place $path.bar -relx 0 -rely 0 -relwidth 1 -relheight 1
+        set type [Widget::getoption $path -type]
+        if { $val != 0 && [string compare $type "normal"] } {
+            set val [expr {$val+$_widget($path,val)}]
+        }
+        set _widget($path,val) $val
+        set max [Widget::getoption $path -maximum]
+        set bd  [expr {2*[$path.bar cget -bd]}]
+        set w   [winfo width  $path.bar]
+        set h   [winfo height $path.bar]
+        if { ![string compare $type "infinite"] } {
+            if { $val > $max } {
+                set _widget($path,dir) [expr {-$_widget($path,dir)}]
+                set val 0
+                set _widget($path,val) 0
+            }
+            if { $val <= $max/2.0 } {
+                set dx0 0.0
+                set dx1 [expr {double($val)/$max}]
+            } else {
+                set dx1 [expr {double($val)/$max}]
+                set dx0 [expr {$dx1-0.5}]
+            }
+            if { $_widget($path,dir) == 1 } {
+                set x0 $dx0
+                set x1 $dx1
+            } else {
+                set x0 [expr {1-$dx1}]
+                set x1 [expr {1-$dx0}]
+            }
+            if { ![string compare [Widget::getoption $path -orient] "horizontal"] } {
+                $path.bar coords rect [expr {$x0*$w}] 0 [expr {$x1*$w}] $h
+            } else {
+                $path.bar coords rect 0 [expr {$h-$x0*$h}] $w [expr {$x1*$h}]
+            }
+        } else {
+            if { $val > $max } {set val $max}
+            if { ![string compare [Widget::getoption $path -orient] "horizontal"] } {
+                $path.bar coords rect -1 0 [expr {$val*$w/$max}] $h
+            } else {
+                $path.bar coords rect 0 [expr {$h+1}] $w [expr {$h*($max-$val)}]
+            }
+        }
+    }
+    update
+}

lib/external/bwidget/progressdlg.tcl

@@ -0,0 +1,89 @@
+# ------------------------------------------------------------------------------
+#  progressdlg.tcl
+#  This file is part of Unifix BWidget Toolkit
+# ------------------------------------------------------------------------------
+#  Index of commands:
+#     - ProgressDlg::create
+# ------------------------------------------------------------------------------
+
+namespace eval ProgressDlg {
+    Dialog::use
+    ProgressBar::use
+
+    Widget::bwinclude ProgressDlg Dialog "" \
+        remove {
+            -modal -image -bitmap -side -anchor -cancel -default
+            -homogeneous -padx -pady -spacing
+        }
+
+    Widget::bwinclude ProgressDlg ProgressBar .frame.pb \
+        remove {-orient -width -height}
+
+    Widget::declare ProgressDlg {
+        {-width        TkResource 25 0 label}
+        {-height       TkResource 2  0 label}
+        {-textvariable TkResource "" 0 label}
+        {-font         TkResource "" 0 label}
+        {-stop         String "" 0}
+        {-command      String "" 0}
+    }
+
+    Widget::addmap ProgressDlg "" .frame.msg \
+        {-width {} -height {} -textvariable {} -font {} -background {}}
+
+    proc ::ProgressDlg { path args } { return [eval ProgressDlg::create $path $args] }
+    proc use {} {}
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ProgressDlg::create
+# ------------------------------------------------------------------------------
+proc ProgressDlg::create { path args } {
+    Widget::init ProgressDlg "$path#ProgressDlg" $args
+
+    eval Dialog::create $path [Widget::subcget "$path#ProgressDlg" ""] \
+        -image [Bitmap::get hourglass] -modal none -side bottom -anchor c
+    wm protocol $path WM_DELETE_WINDOW {;}
+
+    set frame [Dialog::getframe $path]
+    bind $frame <Destroy> "Widget::destroy $path#ProgressDlg"
+    $frame configure -cursor watch
+
+    eval label $frame.msg [Widget::subcget "$path#ProgressDlg" .frame.msg] \
+        -relief flat -borderwidth 0 -highlightthickness 0 -anchor w -justify left
+    pack $frame.msg -side top -pady 3m -anchor nw -fill x -expand yes
+
+    set var [Widget::cget "$path#ProgressDlg" -variable]
+    eval ProgressBar::create $frame.pb [Widget::subcget "$path#ProgressDlg" .frame.pb] \
+        -width 100
+    pack $frame.pb -side bottom -anchor w -fill x -expand yes
+
+    set stop [Widget::cget "$path#ProgressDlg" -stop]
+    set cmd  [Widget::cget "$path#ProgressDlg" -command]
+    if { $stop != "" && $cmd != "" } {
+        Dialog::add $path -text $stop -name $stop -command $cmd
+    }
+    Dialog::draw $path
+    BWidget::grab local $path
+
+    proc ::$path { cmd args } "return \[eval ProgressDlg::\$cmd $path \$args\]"
+
+    return $path
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ProgressDlg::configure
+# ------------------------------------------------------------------------------
+proc ProgressDlg::configure { path args } {
+    return [Widget::configure "$path#ProgressDlg" $args]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ProgressDlg::cget
+# ------------------------------------------------------------------------------
+proc ProgressDlg::cget { path option } {
+    return [Widget::cget "$path#ProgressDlg" $option]
+}

lib/external/bwidget/scrollframe.tcl

@@ -0,0 +1,210 @@
+# ------------------------------------------------------------------------------
+#  scrollframe.tcl
+#  This file is part of Unifix BWidget Toolkit
+#  $Id$
+# ------------------------------------------------------------------------------
+#  Index of commands:
+#     - ScrollableFrame::create
+#     - ScrollableFrame::configure
+#     - ScrollableFrame::cget
+#     - ScrollableFrame::getframe
+#     - ScrollableFrame::see
+#     - ScrollableFrame::xview
+#     - ScrollableFrame::yview
+#     - ScrollableFrame::_resize
+# ------------------------------------------------------------------------------
+
+namespace eval ScrollableFrame {
+    Widget::declare ScrollableFrame {
+        {-background        TkResource "" 0 frame}
+        {-width             Int        0  0 {}}
+        {-height            Int        0  0 {}}
+        {-areawidth         Int        0  0 {}}
+        {-areaheight        Int        0  0 {}}
+        {-constrainedwidth  Boolean    0 0}
+        {-constrainedheight Boolean    0 0}
+        {-xscrollcommand    TkResource "" 0 canvas}
+        {-yscrollcommand    TkResource "" 0 canvas}
+        {-xscrollincrement  TkResource "" 0 canvas}
+        {-yscrollincrement  TkResource "" 0 canvas}
+        {-bg                Synonym    -background}
+    }
+
+    Widget::addmap ScrollableFrame "" :cmd {
+        -background {} -width {} -height {} 
+        -xscrollcommand {} -yscrollcommand {}
+        -xscrollincrement {} -yscrollincrement {}
+    }
+    Widget::addmap ScrollableFrame "" .frame {-background {}}
+
+    variable _widget
+
+    bind BwScrollableFrame <Configure> {ScrollableFrame::_resize %W}
+    bind BwScrollableFrame <Destroy>   {Widget::destroy %W; rename %W {}}
+
+    proc ::ScrollableFrame { path args } { return [eval ScrollableFrame::create $path $args] }
+    proc use {} {}
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ScrollableFrame::create
+# ------------------------------------------------------------------------------
+proc ScrollableFrame::create { path args } {
+    Widget::init ScrollableFrame $path $args
+
+    set canvas [eval canvas $path [Widget::subcget $path :cmd] \
+                    -highlightthickness 0 -borderwidth 0 -relief flat]
+
+    set frame  [eval frame $path.frame [Widget::subcget $path .frame] \
+                    -highlightthickness 0 -borderwidth 0 -relief flat]
+
+    $canvas create window 0 0 -anchor nw -window $frame -tags win \
+        -width  [Widget::cget $path -areawidth] \
+        -height [Widget::cget $path -areaheight]
+
+    bind $frame <Configure> "$canvas:cmd configure -scrollregion {0 0 %w %h}"
+    bindtags $path [list $path BwScrollableFrame [winfo toplevel $path] all]
+
+    rename $path ::$path:cmd
+    proc ::$path { cmd args } "return \[eval ScrollableFrame::\$cmd $path \$args\]"
+
+    return $canvas
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ScrollableFrame::configure
+# ------------------------------------------------------------------------------
+proc ScrollableFrame::configure { path args } {
+    set res [Widget::configure $path $args]
+    set upd 0
+
+    set modcw [Widget::hasChanged $path -constrainedwidth cw]
+    set modw  [Widget::hasChanged $path -areawidth w]
+    if { $modcw || (!$cw && $modw) } {
+        if { $cw } {
+            set w [winfo width $path]
+        }
+        set upd 1
+    }
+
+    set modch [Widget::hasChanged $path -constrainedheight ch]
+    set modh  [Widget::hasChanged $path -areaheight h]
+    if { $modch || (!$ch && $modh) } {
+        if { $ch } {
+            set h [winfo height $path]
+        }
+        set upd 1
+    }
+
+    if { $upd } {
+        $path:cmd itemconfigure win -width $w -height $h
+    }
+    return $res
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ScrollableFrame::cget
+# ------------------------------------------------------------------------------
+proc ScrollableFrame::cget { path option } {
+    return [Widget::cget $path $option]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ScrollableFrame::getframe
+# ------------------------------------------------------------------------------
+proc ScrollableFrame::getframe { path } {
+    return $path.frame
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ScrollableFrame::see
+# ------------------------------------------------------------------------------
+proc ScrollableFrame::see { path widget {vert top} {horz left}} {
+    set x0  [winfo x $widget]
+    set y0  [winfo y $widget]
+    set x1  [expr {$x0+[winfo width  $widget]}]
+    set y1  [expr {$y0+[winfo height $widget]}]
+    set xb0 [$path:cmd canvasx 0]
+    set yb0 [$path:cmd canvasy 0]
+    set xb1 [$path:cmd canvasx [winfo width  $path]]
+    set yb1 [$path:cmd canvasy [winfo height $path]]
+    set dx  0
+    set dy  0
+
+    if { ![string compare $horz "left"] } {
+	if { $x1 > $xb1 } {
+	    set dx [expr {$x1-$xb1}]
+	}
+	if { $x0 < $xb0+$dx } {
+	    set dx [expr {$x0-$xb0}]
+	}
+    } elseif { ![string compare $horz "right"] } {
+	if { $x0 < $xb0 } {
+	    set dx [expr {$x0-$xb0}]
+	}
+	if { $x1 > $xb1+$dx } {
+	    set dx [expr {$x1-$xb1}]
+	}
+    }
+
+    if { ![string compare $vert "top"] } {
+	if { $y1 > $yb1 } {
+	    set dy [expr {$y1-$yb1}]
+	}
+	if { $y0 < $yb0+$dy } {
+	    set dy [expr {$y0-$yb0}]
+	}
+    } elseif { ![string compare $vert "bottom"] } {
+	if { $y0 < $yb0 } {
+	    set dy [expr {$y0-$yb0}]
+	}
+	if { $y1 > $yb1+$dy } {
+	    set dy [expr {$y1-$yb1}]
+	}
+    }
+
+    if { $dx != 0 } {
+	set x [expr {($xb0+$dx)/[winfo width $path.frame]}]
+	$path:cmd xview moveto $x
+    }
+    if { $dy != 0 } {
+	set y [expr {($yb0+$dy)/[winfo height $path.frame]}]
+	$path:cmd yview moveto $y
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ScrollableFrame::xview
+# ------------------------------------------------------------------------------
+proc ScrollableFrame::xview { path args } {
+    return [eval $path:cmd xview $args]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ScrollableFrame::yview
+# ------------------------------------------------------------------------------
+proc ScrollableFrame::yview { path args } {
+    return [eval $path:cmd yview $args]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ScrollableFrame::_resize
+# ------------------------------------------------------------------------------
+proc ScrollableFrame::_resize { path } {
+    if { [Widget::getoption $path -constrainedwidth] } {
+        $path:cmd itemconfigure win -width [winfo width $path]
+    }
+    if { [Widget::getoption $path -constrainedheight] } {
+        $path:cmd itemconfigure win -height [winfo height $path]
+    }
+}
+
+

lib/external/bwidget/scrollview.tcl

@@ -0,0 +1,257 @@
+# ------------------------------------------------------------------------------
+#  scrollview.tcl
+#  This file is part of Unifix BWidget Toolkit
+#  $Id$
+# ------------------------------------------------------------------------------
+#  Index of commands:
+#     - ScrolledWindow::create
+#     - ScrolledWindow::configure
+#     - ScrolledWindow::cget
+#     - ScrolledWindow::_set_hscroll
+#     - ScrolledWindow::_set_vscroll
+#     - ScrolledWindow::_update_scroll
+#     - ScrolledWindow::_set_view
+#     - ScrolledWindow::_resize
+# ------------------------------------------------------------------------------
+
+namespace eval ScrollView {
+    Widget::declare ScrollView {
+        {-width       TkResource 30        0 canvas}
+        {-height      TkResource 30        0 canvas}
+        {-background  TkResource ""        0 canvas}
+        {-foreground  String     black     0}
+        {-fill        String     ""        0}
+        {-relief      TkResource flat      0 canvas}
+        {-borderwidth TkResource 0         0 canvas}
+        {-cursor      TkResource crosshair 0 canvas}
+        {-window      String     ""        0}
+        {-fg          Synonym    -foreground}
+        {-bg          Synonym    -background}
+        {-bd          Synonym    -borderwidth}
+    }
+
+    Widget::addmap ScrollView "" :cmd \
+        {-relief {} -borderwidth {} -background {} -width {} -height {} -cursor {}}
+
+    bind BwScrollView <ButtonPress-3> {ScrollView::_set_view %W set %x %y}
+    bind BwScrollView <ButtonPress-1> {ScrollView::_set_view %W start %x %y}
+    bind BwScrollView <B1-Motion>     {ScrollView::_set_view %W motion %x %y}
+    bind BwScrollView <Configure>     {ScrollView::_resize %W}
+    bind BwScrollView <Destroy>       {ScrollView::_destroy %W}
+
+    proc ::ScrollView { path args } { return [eval ScrollView::create $path $args] }
+    proc use {} {}
+
+    variable _widget
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ScrollView::create
+# ------------------------------------------------------------------------------
+proc ScrollView::create { path args } {
+    variable _widget
+
+    Widget::init ScrollView $path $args
+
+    set w                     [Widget::getoption $path -window]
+    set _widget($path,bd)     [Widget::getoption $path -borderwidth]
+    set _widget($path,width)  [Widget::getoption $path -width]
+    set _widget($path,height) [Widget::getoption $path -height]
+
+    if { [winfo exists $w] } {
+        set _widget($path,oldxscroll) [$w cget -xscrollcommand]
+        set _widget($path,oldyscroll) [$w cget -yscrollcommand]
+        $w configure \
+            -xscrollcommand "ScrollView::_set_hscroll $path" \
+            -yscrollcommand "ScrollView::_set_vscroll $path"
+    }
+    eval canvas $path [Widget::subcget $path :cmd] -highlightthickness 0
+    $path create rectangle -2 -2 -2 -2 \
+        -fill    [Widget::getoption $path -fill]       \
+        -outline [Widget::getoption $path -foreground] \
+        -tags    view
+
+    bindtags $path [list $path BwScrollView [winfo toplevel $path] all]
+
+    rename $path ::$path:cmd
+    proc ::$path { cmd args } "return \[eval ScrollView::\$cmd $path \$args\]"
+
+    return $path
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ScrollView::configure
+# ------------------------------------------------------------------------------
+proc ScrollView::configure { path args } {
+    variable _widget
+
+    set oldw [Widget::getoption $path -window] 
+    set res  [Widget::configure $path $args]
+
+    if { [Widget::hasChanged $path -window w] } {
+        if { [winfo exists $oldw] } {
+            $oldw configure \
+                -xscrollcommand $_widget($path,oldxscroll) \
+                -yscrollcommand $_widget($path,oldyscroll)
+        }
+        if { [winfo exists $w] } {
+            set _widget($path,oldxscroll) [$w cget -xscrollcommand]
+            set _widget($path,oldyscroll) [$w cget -yscrollcommand]
+            $w configure \
+                -xscrollcommand "ScrollView::_set_hscroll $path" \
+                -yscrollcommand "ScrollView::_set_vscroll $path"
+        } else {
+            $path:cmd coords view -2 -2 -2 -2
+            set _widget($path,oldxscroll) {}
+            set _widget($path,oldyscroll) {}
+        }
+    }
+
+    if { [Widget::hasChanged $path -fill fill] |
+         [Widget::hasChanged $path -foreground fg] } {
+        $path:cmd itemconfigure view \
+            -fill    $fill \
+            -outline $fg
+    }
+
+    return $res
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ScrollView::cget
+# ------------------------------------------------------------------------------
+proc ScrollView::cget { path option } {
+    return [Widget::cget $path $option]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ScrollView::_destroy
+# ------------------------------------------------------------------------------
+proc ScrollView::_destroy { path } {
+    variable _widget
+
+    set w [Widget::getoption $path -window] 
+    if { [winfo exists $w] } {
+        $w configure \
+            -xscrollcommand $_widget($path,oldxscroll) \
+            -yscrollcommand $_widget($path,oldyscroll)
+    }
+    unset _widget($path,oldxscroll)
+    unset _widget($path,oldyscroll)
+    unset _widget($path,bd)
+    unset _widget($path,width)
+    unset _widget($path,height)
+    catch {unset _widget($path,dx)}
+    catch {unset _widget($path,dy)}
+    Widget::destroy $path
+    rename $path {}
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ScrollView::_set_hscroll
+# ------------------------------------------------------------------------------
+proc ScrollView::_set_hscroll { path vmin vmax } {
+    variable _widget
+
+    set c  [$path:cmd coords view]
+    set x0 [expr {$vmin*$_widget($path,width)+$_widget($path,bd)}]
+    set x1 [expr {$vmax*$_widget($path,width)+$_widget($path,bd)-1}]
+    $path:cmd coords view $x0 [lindex $c 1] $x1 [lindex $c 3]
+    if { $_widget($path,oldxscroll) != "" } {
+        uplevel \#0 $_widget($path,oldxscroll) $vmin $vmax
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ScrollView::_set_vscroll
+# ------------------------------------------------------------------------------
+proc ScrollView::_set_vscroll { path vmin vmax } {
+    variable _widget
+
+    set c  [$path:cmd coords view]
+    set y0 [expr {$vmin*$_widget($path,height)+$_widget($path,bd)}]
+    set y1 [expr {$vmax*$_widget($path,height)+$_widget($path,bd)-1}]
+    $path:cmd coords view [lindex $c 0] $y0 [lindex $c 2] $y1
+    if { $_widget($path,oldyscroll) != "" } {
+        uplevel \#0 $_widget($path,oldyscroll) $vmin $vmax
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ScrollView::_update_scroll
+# ------------------------------------------------------------------------------
+proc ScrollView::_update_scroll { path callscroll hminmax vminmax } {
+    variable _widget
+
+    set c    [$path:cmd coords view]
+    set hmin [lindex $hminmax 0]
+    set hmax [lindex $hminmax 1]
+    set vmin [lindex $vminmax 0]
+    set vmax [lindex $vminmax 1]
+    set x0   [expr {$hmin*$_widget($path,width)+$_widget($path,bd)}]
+    set x1   [expr {$hmax*$_widget($path,width)+$_widget($path,bd)-1}]
+    set y0   [expr {$vmin*$_widget($path,height)+$_widget($path,bd)}]
+    set y1   [expr {$vmax*$_widget($path,height)+$_widget($path,bd)-1}]
+    $path:cmd coords view $x0 $y0 $x1 $y1
+    if { $callscroll } {
+        if { $_widget($path,oldxscroll) != "" } {
+            uplevel \#0 $_widget($path,oldxscroll) $hmin $hmax
+        }
+        if { $_widget($path,oldyscroll) != "" } {
+            uplevel \#0 $_widget($path,oldyscroll) $vmin $vmax
+        }
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ScrollView::_set_view
+# ------------------------------------------------------------------------------
+proc ScrollView::_set_view { path cmd x y } {
+    variable _widget
+
+    set w [Widget::getoption $path -window]
+    if { [winfo exists $w] } {
+        if { ![string compare $cmd "start"] } {
+            set c  [$path:cmd coords view]
+            set x0 [lindex $c 0]
+            set y0 [lindex $c 1]
+            set _widget($path,dx) [expr {$x-$x0}]
+            set _widget($path,dy) [expr {$y-$y0}]
+        } else {
+            if { ![string compare $cmd "motion"] } {
+                set vh [expr {double($x-$_widget($path,dx)-$_widget($path,bd))/$_widget($path,width)}]
+                set vv [expr {double($y-$_widget($path,dy)-$_widget($path,bd))/$_widget($path,height)}]
+            } else {
+                set vh [expr {double($x-$_widget($path,bd))/$_widget($path,width)}]
+                set vv [expr {double($y-$_widget($path,bd))/$_widget($path,height)}]
+            }
+            $w xview moveto $vh
+            $w yview moveto $vv
+            _update_scroll $path 1 [$w xview] [$w yview]
+        }
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ScrollView::_resize
+# ------------------------------------------------------------------------------
+proc ScrollView::_resize { path } {
+    variable _widget
+
+    set _widget($path,bd)     [Widget::getoption $path -borderwidth]
+    set _widget($path,width)  [expr {[winfo width  $path]-2*$_widget($path,bd)}]
+    set _widget($path,height) [expr {[winfo height $path]-2*$_widget($path,bd)}]
+    set w [Widget::getoption $path -window]
+    if { [winfo exists $w] } {
+        _update_scroll $path 0 [$w xview] [$w yview]
+    }
+}

lib/external/bwidget/scrollw.tcl

@@ -0,0 +1,254 @@
+# ------------------------------------------------------------------------------
+#  scrollw.tcl
+#  This file is part of Unifix BWidget Toolkit
+#  $Id$
+# ------------------------------------------------------------------------------
+#  Index of commands:
+#     - ScrolledWindow::create
+#     - ScrolledWindow::getframe
+#     - ScrolledWindow::setwidget
+#     - ScrolledWindow::configure
+#     - ScrolledWindow::cget
+#     - ScrolledWindow::_set_hscroll
+#     - ScrolledWindow::_set_vscroll
+#     - ScrolledWindow::_realize
+# ------------------------------------------------------------------------------
+
+namespace eval ScrolledWindow {
+    Widget::declare ScrolledWindow {
+        {-background  TkResource ""   0 button}
+        {-scrollbar   Enum       both 1 {none both vertical horizontal}}
+        {-auto        Enum       both 0 {none both vertical horizontal}}
+        {-relief      TkResource flat 0 frame}
+        {-borderwidth TkResource 0    0 frame}
+        {-bg          Synonym    -background}
+        {-bd          Synonym    -borderwidth}
+    }
+
+    Widget::addmap ScrolledWindow "" ._grid.f {-relief {} -borderwidth {}}
+
+    proc ::ScrolledWindow { path args } { return [eval ScrolledWindow::create $path $args] }
+    proc use {} {}
+
+    variable _widget
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ScrolledWindow::create
+# ------------------------------------------------------------------------------
+proc ScrolledWindow::create { path args } {
+    variable _widget
+
+    Widget::init ScrolledWindow $path $args
+
+    set bg     [Widget::cget $path -background]
+    set sw     [frame $path -relief flat -bd 0 -bg $bg -highlightthickness 0 -takefocus 0]
+    set grid   [frame $path._grid -relief flat -bd 0 -bg $bg -highlightthickness 0 -takefocus 0]
+
+    set sb    [lsearch {none horizontal vertical both} [Widget::cget $path -scrollbar]]
+    set auto  [lsearch {none horizontal vertical both} [Widget::cget $path -auto]]
+    set rspan [expr {1 + !($sb & 1)}]
+    set cspan [expr {1 + !($sb & 2)}]
+
+    set _widget($path,realized) 0
+    set _widget($path,sb)       $sb
+    set _widget($path,auto)     $auto
+    set _widget($path,hpack)    [expr {$rspan == 1}]
+    set _widget($path,vpack)    [expr {$cspan == 1}]
+
+    # scrollbar horizontale ou les deux
+    if { $sb & 1 } {
+        scrollbar $grid.hscroll \
+            -highlightthickness 0 -takefocus 0 \
+            -orient  horiz	\
+            -relief  sunken	\
+            -bg      $bg
+        $grid.hscroll set 0 1
+        grid $grid.hscroll -column 0 -row 1 -sticky we -columnspan $cspan -pady 1
+    }
+
+    # scrollbar verticale ou les deux
+    if { $sb & 2 } {
+        scrollbar $grid.vscroll \
+            -highlightthickness 0 -takefocus 0 \
+            -orient  vert  	\
+            -relief  sunken 	\
+            -bg      $bg
+        $grid.vscroll set 0 1
+        grid $grid.vscroll -column 1 -row 0 -sticky ns -rowspan $rspan -padx 1
+    }
+
+    eval frame $grid.f -bg $bg -highlightthickness 0 [Widget::subcget $path ._grid.f]
+    grid $grid.f -column 0 -row 0 -sticky nwse -columnspan $cspan -rowspan $rspan
+    grid columnconfigure $grid 0 -weight 1
+    grid rowconfigure    $grid 0 -weight 1
+    pack $grid -fill both -expand yes
+
+    bind $grid <Configure> "ScrolledWindow::_realize $path"
+    bind $grid <Destroy>   "ScrolledWindow::_destroy $path"
+
+    rename $path ::$path:cmd
+    proc ::$path { cmd args } "return \[eval ScrolledWindow::\$cmd $path \$args\]"
+
+    return $path
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ScrolledWindow::getframe
+# ------------------------------------------------------------------------------
+proc ScrolledWindow::getframe { path } {
+    return $path
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ScrolledWindow::setwidget
+# ------------------------------------------------------------------------------
+proc ScrolledWindow::setwidget { path widget } {
+    variable _widget
+
+    set grid   $path._grid
+    set sb     $_widget($path,sb)
+    set option {}
+
+    pack $widget -in $grid.f -fill both -expand yes
+
+    # scrollbar horizontale ou les deux
+    if { $sb & 1 } {
+        $grid.hscroll configure -command "$widget xview"
+        lappend option  "-xscrollcommand" "ScrolledWindow::_set_hscroll $path"
+    }
+
+    # scrollbar verticale ou les deux
+    if { $sb & 2 } {
+        $grid.vscroll configure -command "$widget yview"
+        lappend option  "-yscrollcommand" "ScrolledWindow::_set_vscroll $path"
+    }
+    if { [llength $option] } {
+        eval $widget configure $option
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ScrolledWindow::configure
+# ------------------------------------------------------------------------------
+proc ScrolledWindow::configure { path args } {
+    variable _widget
+
+    set grid $path._grid
+    set res [Widget::configure $path $args]
+    if { [Widget::hasChanged $path -background bg] } {
+        $path configure -background $bg
+        $grid configure -background $bg
+        $grid.f configure -background $bg
+        catch {$grid.hscroll configure -background $bg}
+        catch {$grid.vscroll configure -background $bg}
+    }
+    if { [Widget::hasChanged $path -auto auto] } {
+        set _widget($path,auto) [lsearch {none horizontal vertical both} $auto]
+        if { $_widget($path,sb) & 1 } {
+            eval _set_hscroll $path [$grid.hscroll get]
+        }
+        if { $_widget($path,sb) & 2 } {
+            eval _set_vscroll $path [$grid.vscroll get]
+        }
+    }
+    return $res
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ScrolledWindow::cget
+# ------------------------------------------------------------------------------
+proc ScrolledWindow::cget { path option } {
+    return [Widget::cget $path $option]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ScrolledWindow::_destroy
+# ------------------------------------------------------------------------------
+proc ScrolledWindow::_destroy { path } {
+    variable _widget
+
+    unset _widget($path,sb)
+    unset _widget($path,auto)
+    unset _widget($path,hpack)
+    unset _widget($path,vpack)
+    Widget::destroy $path
+    rename $path {}
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ScrolledWindow::_set_hscroll
+# ------------------------------------------------------------------------------
+proc ScrolledWindow::_set_hscroll { path vmin vmax } {
+    variable _widget
+
+    if { $_widget($path,realized) } {
+        set grid $path._grid
+        if { $_widget($path,auto) & 1 } {
+            if { $_widget($path,hpack) && $vmin == 0 && $vmax == 1 } {
+                grid configure $grid.f -rowspan 2
+                if { $_widget($path,sb) & 2 } {
+                    grid configure $grid.vscroll -rowspan 2
+                }
+                set _widget($path,hpack) 0
+            } elseif { !$_widget($path,hpack) && ($vmin != 0 || $vmax != 1) } {
+                grid configure $grid.f -rowspan 1
+                if { $_widget($path,sb) & 2 } {
+                    grid configure $grid.vscroll -rowspan 1
+                }
+                set _widget($path,hpack) 1
+            }
+        }
+        $grid.hscroll set $vmin $vmax
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ScrolledWindow::_set_vscroll
+# ------------------------------------------------------------------------------
+proc ScrolledWindow::_set_vscroll { path vmin vmax } {
+    variable _widget
+
+    if { $_widget($path,realized) } {
+        set grid $path._grid
+        if { $_widget($path,auto) & 2 } {
+            if { $_widget($path,vpack) && $vmin == 0 && $vmax == 1 } {
+                grid configure $grid.f -columnspan 2
+                if { $_widget($path,sb) & 1 } {
+                    grid configure $grid.hscroll -columnspan 2
+                }
+                set _widget($path,vpack) 0
+            } elseif { !$_widget($path,vpack) && ($vmin != 0 || $vmax != 1) } {
+                grid configure $grid.f -columnspan 1
+                if { $_widget($path,sb) & 1 } {
+                    grid configure $grid.hscroll -columnspan 1
+                }
+                set _widget($path,vpack) 1
+            }
+        }
+        $grid.vscroll set $vmin $vmax
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ScrolledWindow::_realize
+# ------------------------------------------------------------------------------
+proc ScrolledWindow::_realize { path } {
+    variable _widget
+
+    set grid $path._grid
+    bind  $grid <Configure> {}
+    set _widget($path,realized) 1
+    place $grid -anchor nw -x 0 -y 0 -relwidth 1.0 -relheight 1.0
+}
+
+

lib/external/bwidget/separator.tcl

@@ -0,0 +1,82 @@
+# ------------------------------------------------------------------------------
+#  separator.tcl
+#  This file is part of Unifix BWidget Toolkit
+# ------------------------------------------------------------------------------
+#  Index of commands:
+#     - Separator::create
+#     - Separator::configure
+#     - Separator::cget
+# ------------------------------------------------------------------------------
+
+namespace eval Separator {
+    Widget::declare Separator {
+        {-background TkResource ""         0 frame}
+        {-relief     Enum       groove     0 {ridge groove}}
+        {-orient     Enum       horizontal 1 {horizontal vertical}}
+        {-bg         Synonym    -background}
+    }
+    Widget::addmap Separator "" :cmd {-background {}}
+
+    proc ::Separator { path args } { return [eval Separator::create $path $args] }
+    proc use {} {}
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Separator::create
+# ------------------------------------------------------------------------------
+proc Separator::create { path args } {
+    Widget::init Separator $path $args
+
+    if { [Widget::getoption $path -relief] == "groove" } {
+        set relief sunken
+    } else {
+        set relief raised
+    }
+
+    if { [Widget::getoption $path -orient] == "horizontal" } {
+        frame $path \
+            -background  [Widget::getoption $path -background] \
+            -borderwidth 1 \
+            -relief      $relief \
+            -height      2
+    } else {
+        frame $path \
+            -background  [Widget::getoption $path -background] \
+            -borderwidth 1 \
+            -relief      $relief \
+            -width       2
+    }
+    bind $path <Destroy> {Widget::destroy %W; rename %W {}}
+
+    rename $path ::$path:cmd
+    proc ::$path { cmd args } "return \[eval Separator::\$cmd $path \$args\]"
+
+    return $path
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Separator::configure
+# ------------------------------------------------------------------------------
+proc Separator::configure { path args } {
+    set res [Widget::configure $path $args]
+
+    if { [Widget::hasChanged $path -relief relief] } {
+        if { $relief == "groove" } {
+            $path:cmd configure -relief sunken
+        } else {
+            $path:cmd configure -relief raised
+        }
+    }
+
+    return $res
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Separator::cget
+# ------------------------------------------------------------------------------
+proc Separator::cget { path option } {
+    return [Widget::cget $path $option]
+}

lib/external/bwidget/spinbox.tcl

@@ -0,0 +1,353 @@
+# ------------------------------------------------------------------------------
+#  spinbox.tcl
+#  This file is part of Unifix BWidget Toolkit
+# ------------------------------------------------------------------------------
+#  Index of commands:
+#     - SpinBox::create
+#     - SpinBox::configure
+#     - SpinBox::cget
+#     - SpinBox::setvalue
+#     - SpinBox::_destroy
+#     - SpinBox::_modify_value
+#     - SpinBox::_test_options
+# ------------------------------------------------------------------------------
+
+namespace eval SpinBox {
+    ArrowButton::use
+    Entry::use
+    LabelFrame::use
+
+    Widget::bwinclude SpinBox LabelFrame .labf \
+        rename     {-text -label} \
+        prefix     {label -justify -width -anchor -height -font} \
+        remove     {-focus} \
+        initialize {-relief sunken -borderwidth 2}
+
+    Widget::bwinclude SpinBox Entry .e \
+        remove {-relief -bd -borderwidth -fg -bg} \
+        rename {-foreground -entryfg -background -entrybg}
+
+    Widget::declare SpinBox {
+        {-range          String ""  0}
+        {-values         String ""  0}
+        {-modifycmd      String ""  0}
+        {-repeatdelay    Int    400 0 {=0}}
+        {-repeatinterval Int    100 0 {=0}}
+    }
+
+    Widget::addmap SpinBox "" :cmd {-background {}}
+    Widget::addmap SpinBox ArrowButton .arrup {
+        -foreground {} -background {} -disabledforeground {} -state {}
+        -repeatdelay {} -repeatinterval {}
+    }
+    Widget::addmap SpinBox ArrowButton .arrdn {
+        -foreground {} -background {} -disabledforeground {} -state {}
+        -repeatdelay {} -repeatinterval {}
+    }
+
+    Widget::syncoptions SpinBox Entry .e {-text {}}
+    Widget::syncoptions SpinBox LabelFrame .labf {-label -text -underline {}}
+
+    ::bind BwSpinBox <FocusIn> {focus %W.labf}
+    ::bind BwSpinBox <Destroy> {SpinBox::_destroy %W}
+
+    proc ::SpinBox { path args } { return [eval SpinBox::create $path $args] }
+    proc use {} {}
+
+    variable _widget
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command SpinBox::create
+# ------------------------------------------------------------------------------
+proc SpinBox::create { path args } {
+    variable _widget
+
+    Widget::init SpinBox $path $args
+
+    _test_options $path
+    eval frame $path [Widget::subcget $path :cmd] \
+        -highlightthickness 0 -bd 0 -relief flat -takefocus 0
+    set labf [eval LabelFrame::create $path.labf [Widget::subcget $path .labf] \
+                  -borderwidth 2 -relief sunken -focus $path.e]
+    set entry [eval Entry::create $path.e [Widget::subcget $path .e] \
+                   -relief flat -borderwidth 0]
+
+    bindtags $path [list $path BwSpinBox [winfo toplevel $path] all]
+
+    set farr   [frame $path.farr -relief flat -bd 0 -highlightthickness 0]
+    set height [expr {[winfo reqheight $path.e]/2-2}]
+    set width  11
+    set arrup  [eval ArrowButton::create $path.arrup -dir top \
+                    [Widget::subcget $path .arrup] \
+                    -highlightthickness 0 -borderwidth 1 -takefocus 0 \
+                    -type button \
+                    -width $width -height $height \
+                    -armcommand    [list "SpinBox::_modify_value $path next arm"] \
+                    -disarmcommand [list "SpinBox::_modify_value $path next disarm"]]
+    set arrdn  [eval ArrowButton::create $path.arrdn -dir bottom \
+                    [Widget::subcget $path .arrdn] \
+                    -highlightthickness 0 -borderwidth 1 -takefocus 0 \
+                    -type button \
+                    -width $width -height $height \
+                    -armcommand    [list "SpinBox::_modify_value $path previous arm"] \
+                    -disarmcommand [list "SpinBox::_modify_value $path previous disarm"]]
+    set frame [LabelFrame::getframe $path.labf]
+
+    # --- update -value ---
+    if { [set val [Entry::cget $path.e -text]] != "" } {
+        set _widget($path,curval) $val
+    } else {
+        if { [set var [Widget::getoption $path -textvariable]] != "" } {
+            GlobalVar::setvar $var $_widget($path,curval)
+        } else {
+            Entry::configure $path.e -text $_widget($path,curval)
+        }
+    }
+    Widget::setoption $path -text $_widget($path,curval)
+
+    grid $arrup -in $farr -column 0 -row 0 -sticky nsew
+    grid $arrdn -in $farr -column 0 -row 2 -sticky nsew
+    grid rowconfigure $farr 0 -weight 1
+    grid rowconfigure $farr 2 -weight 1
+
+    pack $farr  -in $frame -side right -fill y
+    pack $entry -in $frame -side left  -fill both -expand yes
+    pack $labf  -fill both -expand yes
+
+    ::bind $entry <Key-Up>    "SpinBox::_modify_value $path next activate"
+    ::bind $entry <Key-Down>  "SpinBox::_modify_value $path previous activate"
+    ::bind $entry <Key-Prior> "SpinBox::_modify_value $path last activate"
+    ::bind $entry <Key-Next>  "SpinBox::_modify_value $path first activate"
+
+    ::bind $farr <Configure> {grid rowconfigure %W 1 -minsize [expr {%h%%2}]}
+
+    rename $path ::$path:cmd
+    proc ::$path { cmd args } "return \[eval SpinBox::\$cmd $path \$args\]"
+
+    return $path
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command SpinBox::configure
+# ------------------------------------------------------------------------------
+proc SpinBox::configure { path args } {
+    set res [Widget::configure $path $args]
+    if { [Widget::hasChanged $path -values val] ||
+         [Widget::hasChanged $path -range  val] } {
+        _test_options $path
+    }
+    return $res
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command SpinBox::cget
+# ------------------------------------------------------------------------------
+proc SpinBox::cget { path option } {
+    return [Widget::cget $path $option]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command SpinBox::setvalue
+# ------------------------------------------------------------------------------
+proc SpinBox::setvalue { path index } {
+    variable _widget
+
+    set values [Widget::getoption $path -values]
+    set value  [Entry::cget $path.e -text]
+
+    if { [llength $values] } {
+        # --- -values SpinBox ---
+        switch -- $index {
+            next {
+                if { [set idx [lsearch $values $value]] != -1 } {
+                    incr idx
+                } elseif { [set idx [lsearch $values "$value*"]] == -1 } {
+                    set idx [lsearch $values $_widget($path,curval)]
+                }
+            }
+            previous {
+                if { [set idx [lsearch $values $value]] != -1 } {
+                    incr idx -1
+                } elseif { [set idx [lsearch $values "$value*"]] == -1 } {
+                    set idx [lsearch $values $_widget($path,curval)]
+                }
+            }
+            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 { [catch {string compare [expr {int($idx)}] $idx} res] || $res != 0 } {
+                        return -code error "bad index \"$index\""
+                    }
+                } else {
+                    return -code error "bad index \"$index\""
+                }
+            }
+        }
+        if { $idx >= 0 && $idx < [llength $values] } {
+            set newval [lindex $values $idx]
+        } else {
+            return 0
+        }
+    } else {
+        # --- -range SpinBox ---
+        set range [Widget::getoption $path -range]
+        set vmin  [lindex $range 0]
+        set vmax  [lindex $range 1]
+        set incr  [lindex $range 2]
+        switch -- $index {
+            next {
+                if { [catch {expr {double($value-$vmin)/$incr}} idx] } {
+                    set newval $_widget($path,curval)
+                } else {
+                    set newval [expr {$vmin+(round($idx)+1)*$incr}]
+                    if { $newval < $vmin } {
+                        set newval $vmin
+                    } elseif { $newval > $vmax } {
+                        set newval $vmax
+                    }
+                }
+            }
+            previous {
+                if { [catch {expr {double($value-$vmin)/$incr}} idx] } {
+                    set newval $_widget($path,curval)
+                } else {
+                    set newval [expr {$vmin+(round($idx)-1)*$incr}]
+                    if { $newval < $vmin } {
+                        set newval $vmin
+                    } elseif { $newval > $vmax } {
+                        set newval $vmax
+                    }
+                }
+            }
+            first {
+                set newval $vmin
+            }
+            last {
+                set newval $vmax
+            }
+            default {
+                if { [string index $index 0] == "@" } {
+                    set idx [string range $index 1 end]
+                    if { [catch {string compare [expr {int($idx)}] $idx} res] || $res != 0 } {
+                        return -code error "bad index \"$index\""
+                    }
+                    set newval [expr {$vmin+int($idx)*$incr}]
+                    if { $newval < $vmin || $newval > $vmax } {
+                        return 0
+                    }
+                } else {
+                    return -code error "bad index \"$index\""
+                }
+            }
+        }
+    }
+    set _widget($path,curval) $newval
+    Widget::setoption $path -text $newval
+    if { [set varname [Entry::cget $path.e -textvariable]] != "" } {
+        GlobalVar::setvar $varname $newval
+    } else {
+        Entry::configure $path.e -text $newval
+    }
+    return 1
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command SpinBox::getvalue
+# ------------------------------------------------------------------------------
+proc SpinBox::getvalue { path } {
+    variable _widget
+
+    set values [Widget::getoption $path -values]
+    set value  [Entry::cget $path.e -text]
+
+    if { [llength $values] } {
+        # --- -values SpinBox ---
+        return  [lsearch $values $value]
+    } else {
+        set range [Widget::getoption $path -range]
+        set vmin  [lindex $range 0]
+        set vmax  [lindex $range 1]
+        set incr  [lindex $range 2]
+        if { ![catch {expr {double($value-$vmin)/$incr}} idx] &&
+             $idx == int($idx) } {
+            return [expr {int($idx)}]
+        }
+        return -1
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command SpinBox::bind
+# ------------------------------------------------------------------------------
+proc SpinBox::bind { path args } {
+    return [eval ::bind $path.e $args]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command SpinBox::_destroy
+# ------------------------------------------------------------------------------
+proc SpinBox::_destroy { path } {
+    variable _widget
+
+    unset _widget($path,curval)
+    Widget::destroy $path
+    rename $path {}
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command SpinBox::_modify_value
+# ------------------------------------------------------------------------------
+proc SpinBox::_modify_value { path direction reason } {
+    if { $reason == "arm" || $reason == "activate" } {
+        SpinBox::setvalue $path $direction
+    }
+    if { ($reason == "disarm" || $reason == "activate") &&
+         [set cmd [Widget::getoption $path -modifycmd]] != "" } {
+        uplevel \#0 $cmd
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command SpinBox::_test_options
+# ------------------------------------------------------------------------------
+proc SpinBox::_test_options { path } {
+    variable _widget
+
+    set values [Widget::getoption $path -values]
+    if { [llength $values] } {
+        set _widget($path,curval) [lindex $values 0]
+    } else {
+        set range [Widget::getoption $path -range]
+        set vmin  [lindex $range 0]
+        set vmax  [lindex $range 1]
+        set incr  [lindex $range 2]
+        if { [catch {expr {int($vmin)}}] } {
+            set vmin 0
+        }
+        if { [catch {expr {$vmax<$vmin}} res] || $res } {
+            set vmax $vmin
+        }
+        if { [catch {expr {$incr<0}} res] || $res } {
+            set incr 1
+        }
+        Widget::setoption $path -range [list $vmin $vmax $incr]
+        set _widget($path,curval) $vmin
+    }
+}
+

lib/external/bwidget/titleframe.tcl

@@ -0,0 +1,152 @@
+# ------------------------------------------------------------------------------
+#  titleframe.tcl
+#  This file is part of Unifix BWidget Toolkit
+# ------------------------------------------------------------------------------
+#  Index of commands:
+#     - TitleFrame::create
+#     - TitleFrame::configure
+#     - TitleFrame::cget
+#     - TitleFrame::getframe
+#     - TitleFrame::_place
+# ------------------------------------------------------------------------------
+
+namespace eval TitleFrame {
+    Widget::declare TitleFrame {
+        {-relief      TkResource groove 0 frame}
+        {-borderwidth TkResource 2      0 frame}
+        {-font        TkResource ""     0 label}
+        {-foreground  TkResource ""     0 label}
+        {-background  TkResource ""     0 frame}
+        {-text        String     ""     0}
+        {-ipad        Int        4      0 {=0 ""}}
+        {-side        Enum       left   0 {left center right}}
+        {-baseline    Enum       center 0 {top center bottom}}
+        {-fg          Synonym    -foreground}
+        {-bg          Synonym    -background}
+        {-bd          Synonym    -borderwidth}
+    }
+
+    Widget::addmap TitleFrame "" :cmd {-background {}}
+    Widget::addmap TitleFrame "" .l   {-background {} -foreground {} -text {} -font {}}
+    Widget::addmap TitleFrame "" .p   {-background {}}
+    Widget::addmap TitleFrame "" .b   {-background {} -relief {} -borderwidth {}}
+    Widget::addmap TitleFrame "" .b.p {-background {}}
+    Widget::addmap TitleFrame "" .f   {-background {}}
+
+    proc ::TitleFrame { path args } { return [eval TitleFrame::create $path $args] }
+    proc use {} {}
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command TitleFrame::create
+# ------------------------------------------------------------------------------
+proc TitleFrame::create { path args } {
+    Widget::init TitleFrame $path $args
+
+    set bg     [Widget::getoption $path -background]
+    set frame  [frame $path -background $bg]
+    set padtop [frame $path.p -relief flat -borderwidth 0 -background $bg]
+    set border [eval frame $path.b [Widget::subcget $path .b] -highlightthickness 0]
+    set label  [eval label $path.l [Widget::subcget $path .l] \
+                    -highlightthickness 0 \
+                    -relief flat \
+                    -bd     0 -padx 2 -pady 0]
+    set padbot [frame $border.p -relief flat -bd 0 -bg $bg -highlightthickness 0]
+    set frame  [frame $path.f -relief flat -bd 0 -bg $bg -highlightthickness 0]
+    set height [winfo reqheight $label]
+
+    switch [Widget::getoption $path -side] {
+        left   { set relx 0.0; set x 5;  set anchor nw }
+        center { set relx 0.5; set x 0;  set anchor n  }
+        right  { set relx 1.0; set x -5; set anchor ne }
+    }
+    set bd [Widget::getoption $path -borderwidth]
+    switch [Widget::getoption $path -baseline] {
+        top    { set htop $height; set hbot 1; set y 0 }
+        center { set htop [expr {$height/2}]; set hbot [expr {$height/2+$height%2+1}]; set y 0 }
+        bottom { set htop 1; set hbot $height; set y [expr {$bd+1}] }
+    }
+    $padtop configure -height $htop
+    $padbot configure -height $hbot
+
+    set pad [Widget::getoption $path -ipad]
+    pack $padbot -side top -fill x
+    pack $frame  -in $border -fill both -expand yes -padx $pad -pady $pad
+
+    pack $padtop -side top -fill x
+    pack $border -fill both -expand yes
+
+    place $label -relx $relx -x $x -anchor $anchor -y $y
+
+    bind $label <Configure> "TitleFrame::_place $path"
+    bind $path  <Destroy>   {Widget::destroy %W; rename %W {}}
+
+    rename $path ::$path:cmd
+    proc ::$path { cmd args } "return \[eval TitleFrame::\$cmd $path \$args\]"
+
+    return $path
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command TitleFrame::configure
+# ------------------------------------------------------------------------------
+proc TitleFrame::configure { path args } {
+    set res [Widget::configure $path $args]
+
+    if { [Widget::hasChanged $path -ipad pad] } {
+        pack configure $path.f -padx $pad -pady $pad
+    }
+    if { [Widget::hasChanged $path -borderwidth val] |
+         [Widget::hasChanged $path -font        val] |
+         [Widget::hasChanged $path -side        val] |
+         [Widget::hasChanged $path -baseline    val] } {
+        _place $path
+    }
+
+    return $res
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command TitleFrame::cget
+# ------------------------------------------------------------------------------
+proc TitleFrame::cget { path option } {
+    return [Widget::cget $path $option]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command TitleFrame::getframe
+# ------------------------------------------------------------------------------
+proc TitleFrame::getframe { path } {
+    return $path.f
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command TitleFrame::_place
+# ------------------------------------------------------------------------------
+proc TitleFrame::_place { path } {
+    set height [winfo height $path.l]
+    switch [Widget::getoption $path -side] {
+        left    { set relx 0.0; set x 10;  set anchor nw }
+        center  { set relx 0.5; set x 0;   set anchor n  }
+        right   { set relx 1.0; set x -10; set anchor ne }
+    }
+    set bd [Widget::getoption $path -borderwidth]
+    switch [Widget::getoption $path -baseline] {
+        top    { set htop $height; set hbot 1; set y 0 }
+        center { set htop [expr {$height/2}]; set hbot [expr {$height/2+$height%2+1}]; set y 0 }
+        bottom { set htop 1; set hbot $height; set y [expr {$bd+1}] }
+    }
+    $path.p   configure -height $htop
+    $path.b.p configure -height $hbot
+
+    place $path.l -relx $relx -x $x -anchor $anchor -y $y
+}
+
+
+
+

lib/external/bwidget/utils.tcl

@@ -0,0 +1,408 @@
+# ------------------------------------------------------------------------------
+#  utils.tcl
+#  This file is part of Unifix BWidget Toolkit
+#  $Id$
+# ------------------------------------------------------------------------------
+#  Index of commands:
+#     - GlobalVar::exists
+#     - GlobalVar::setvarvar
+#     - GlobalVar::getvarvar
+#     - BWidget::assert
+#     - BWidget::clonename
+#     - BWidget::get3dcolor
+#     - BWidget::XLFDfont
+#     - BWidget::place
+#     - BWidget::grab
+#     - BWidget::focus
+# ------------------------------------------------------------------------------
+
+namespace eval GlobalVar {
+    proc use {} {}
+}
+
+
+namespace eval BWidget {
+    variable _top
+    variable _gstack {}
+    variable _fstack {}
+    proc use {} {}
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command GlobalVar::exists
+# ------------------------------------------------------------------------------
+proc GlobalVar::exists { varName } {
+    return [uplevel \#0 [list info exists $varName]]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command GlobalVar::setvar
+# ------------------------------------------------------------------------------
+proc GlobalVar::setvar { varName value } {
+    return [uplevel \#0 [list set $varName $value]]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command GlobalVar::getvar
+# ------------------------------------------------------------------------------
+proc GlobalVar::getvar { varName } {
+    return [uplevel \#0 [list set $varName]]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command GlobalVar::tracevar
+# ------------------------------------------------------------------------------
+proc GlobalVar::tracevar { cmd varName args } {
+    return [uplevel \#0 trace $cmd [list $varName] $args]
+}
+
+
+
+# ------------------------------------------------------------------------------
+#  Command BWidget::lreorder
+# ------------------------------------------------------------------------------
+proc BWidget::lreorder { list neworder } {
+    set pos     0
+    set newlist {}
+    foreach e $neworder {
+        if { [lsearch -exact $list $e] != -1 } {
+            lappend newlist $e
+            set tabelt($e)  1
+        }
+    }
+    set len [llength $newlist]
+    if { !$len } {
+        return $list
+    }
+    if { $len == [llength $list] } {
+        return $newlist
+    }
+    set pos 0
+    foreach e $list {
+        if { ![info exists tabelt($e)] } {
+            set newlist [linsert $newlist $pos $e]
+        }
+        incr pos
+    }
+    return $newlist
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command BWidget::assert
+# ------------------------------------------------------------------------------
+proc BWidget::assert { exp {msg ""}} {
+    set res [uplevel expr $exp]
+    if { !$res} {
+        if { $msg == "" } {
+            return -code error "Assertion failed: {$exp}"
+        } else {
+            return -code error $msg
+        }
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command BWidget::clonename
+# ------------------------------------------------------------------------------
+proc BWidget::clonename { menu } {
+    set path     ""
+    set menupath ""
+    set found    0
+    foreach widget [lrange [split $menu "."] 1 end] {
+        if { $found || [winfo class "$path.$widget"] == "Menu" } {
+            set found 1
+            append menupath "#" $widget
+            append path "." $menupath
+        } else {
+            append menupath "#" $widget
+            append path "." $widget
+        }    
+    }
+    return $path
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command BWidget::getname
+# ------------------------------------------------------------------------------
+proc BWidget::getname { name } {
+    if { [string length $name] } {
+        set text [option get . "${name}Name" ""]
+        if { [string length $text] } {
+            return [parsetext $text]
+        }
+    }
+    return {}
+ }
+
+
+# ------------------------------------------------------------------------------
+#  Command BWidget::parsetext
+# ------------------------------------------------------------------------------
+proc BWidget::parsetext { text } {
+    set result ""
+    set index  -1
+    set start  0
+    while { [string length $text] } {
+        set idx [string first "&" $text]
+        if { $idx == -1 } {
+            append result $text
+            set text ""
+        } else {
+            set char [string index $text [expr {$idx+1}]]
+            if { $char == "&" } {
+                append result [string range $text 0 $idx]
+                set    text   [string range $text [expr {$idx+2}] end]
+                set    start  [expr {$start+$idx+1}]
+            } else {
+                append result [string range $text 0 [expr {$idx-1}]]
+                set    text   [string range $text [expr {$idx+1}] end]
+                incr   start  $idx
+                set    index  $start
+            }
+        }
+    }
+    return [list $result $index]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command BWidget::get3dcolor
+# ------------------------------------------------------------------------------
+proc BWidget::get3dcolor { path bgcolor } {
+    foreach val [winfo rgb $path $bgcolor] {
+        lappend dark [expr 60*$val/100]
+        set tmp1 [expr 14*$val/10]
+        if { $tmp1 > 65535 } {
+            set tmp1 65535
+        }
+        set tmp2 [expr (65535+$val)/2]
+        lappend light [expr ($tmp1 > $tmp2) ? $tmp1:$tmp2]
+    }
+    return [list [eval format "#%04x%04x%04x" $dark] [eval format "#%04x%04x%04x" $light]]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command BWidget::XLFDfont
+# ------------------------------------------------------------------------------
+proc BWidget::XLFDfont { cmd args } {
+    switch -- $cmd {
+        create {
+            set font "-*-*-*-*-*-*-*-*-*-*-*-*-*-*"
+        }
+        configure {
+            set font [lindex $args 0]
+            set args [lrange $args 1 end]
+        }
+        default {
+            return -code error "XLFDfont: commande incorrecte: $cmd"
+        }
+    }
+    set lfont [split $font "-"]
+    if { [llength $lfont] != 15 } {
+        return -code error "XLFDfont: description XLFD incorrecte: $font"
+    }
+
+    foreach {option value} $args {
+        switch -- $option {
+            -foundry { set index 1 }
+            -family  { set index 2 }
+            -weight  { set index 3 }
+            -slant   { set index 4 }
+            -size    { set index 7 }
+            default  { return -code error "XLFDfont: option incorrecte: $option" }
+        }
+        set lfont [lreplace $lfont $index $index $value]
+    }
+    return [join $lfont "-"]
+}
+
+
+
+# ------------------------------------------------------------------------------
+#  Command BWidget::place
+# ------------------------------------------------------------------------------
+proc BWidget::place { path w h args } {
+    variable _top
+
+    update idletasks
+    set reqw [winfo reqwidth  $path]
+    set reqh [winfo reqheight $path]
+    if { $w == 0 } {set w $reqw}
+    if { $h == 0 } {set h $reqh}
+
+    set arglen [llength $args]
+    if { $arglen > 3 } {
+        return -code error "BWidget::place: bad number of argument"
+    }
+
+    if { $arglen > 0 } {
+        set where [lindex $args 0]
+        set idx   [lsearch {"at" "center" "left" "right" "above" "below"} $where]
+        if { $idx == -1 } {
+            return -code error "BWidget::place: incorrect position \"$where\""
+        }
+        if { $idx == 0 } {
+            set err [catch {
+                set x [expr {int([lindex $args 1])}]
+                set y [expr {int([lindex $args 2])}]
+            }]
+            if { $err } {
+                return -code error "BWidget::place: incorrect position"
+            }
+            if { $x >= 0 } {
+                set x "+$x"
+            }
+            if { $y >= 0 } {
+                set y "+$y"
+            }
+        } else {
+            if { $arglen == 2 } {
+                set widget [lindex $args 1]
+                if { ![winfo exists $widget] } {
+                    return -code error "BWidget::place: \"$widget\" does not exist"
+                }
+            }
+            set sw [winfo screenwidth  $path]
+            set sh [winfo screenheight $path]
+            if { $idx == 1 } {
+                if { $arglen == 2 } {
+                    # center to widget
+                    set x0 [expr [winfo rootx $widget] + ([winfo width  $widget] - $w)/2]
+                    set y0 [expr [winfo rooty $widget] + ([winfo height $widget] - $h)/2]
+                } else {
+                    # center to screen
+                    set x0 [expr ([winfo screenwidth  $path] - $w)/2 - [winfo vrootx $path]]
+                    set y0 [expr ([winfo screenheight $path] - $h)/2 - [winfo vrooty $path]]
+                }
+                set x "+$x0"
+                set y "+$y0"
+                if { $x0+$w > $sw } {set x "-0"; set x0 [expr {$sw-$w}]}
+                if { $x0 < 0 }      {set x "+0"}
+                if { $y0+$h > $sh } {set y "-0"; set y0 [expr {$sh-$h}]}
+                if { $y0 < 0 }      {set y "+0"}
+            } else {
+                set x0 [winfo rootx $widget]
+                set y0 [winfo rooty $widget]
+                set x1 [expr {$x0 + [winfo width  $widget]}]
+                set y1 [expr {$y0 + [winfo height $widget]}]
+                if { $idx == 2 || $idx == 3 } {
+                    set y "+$y0"
+                    if { $y0+$h > $sh } {set y "-0"; set y0 [expr {$sh-$h}]}
+                    if { $y0 < 0 }      {set y "+0"}
+                    if { $idx == 2 } {
+                        # try left, then right if out, then 0 if out
+                        if { $x0 >= $w } {
+                            set x [expr {$x0-$sw}]
+                        } elseif { $x1+$w <= $sw } {
+                            set x "+$x1"
+                        } else {
+                            set x "+0"
+                        }
+                    } else {
+                        # try right, then left if out, then 0 if out
+                        if { $x1+$w <= $sw } {
+                            set x "+$x1"
+                        } elseif { $x0 >= $w } {
+                            set x [expr {$x0-$sw}]
+                        } else {
+                            set x "-0"
+                        }
+                    }
+                } else {
+                    set x "+$x0"
+                    if { $x0+$w > $sw } {set x "-0"; set x0 [expr {$sw-$w}]}
+                    if { $x0 < 0 }      {set x "+0"}
+                    if { $idx == 4 } {
+                        # try top, then bottom, then 0
+                        if { $h <= $y0 } {
+                            set y [expr {$y0-$sh}]
+                        } elseif { $y1+$h <= $sh } {
+                            set y "+$y1"
+                        } else {
+                            set y "+0"
+                        }
+                    } else {
+                        # try bottom, then top, then 0
+                        if { $y1+$h <= $sh } {
+                            set y "+$y1"
+                        } elseif { $h <= $y0 } {
+                            set y [expr {$y0-$sh}]
+                        } else {
+                            set y "-0"
+                        }
+                    }
+                }
+            }
+        }
+        wm geometry $path "${w}x${h}${x}${y}"
+    } else {
+        wm geometry $path "${w}x${h}"
+    }
+    update idletasks
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command BWidget::grab
+# ------------------------------------------------------------------------------
+proc BWidget::grab { option path } {
+    variable _gstack
+
+    if { $option == "release" } {
+        catch {::grab release $path}
+        while { [llength $_gstack] } {
+            set grinfo  [lindex $_gstack end]
+            set _gstack [lreplace $_gstack end end]
+            foreach {oldg mode} $grinfo {
+                if { [string compare $oldg $path] && [winfo exists $oldg] } {
+                    if { $mode == "global" } {
+                        catch {::grab -global $oldg}
+                    } else {
+                        catch {::grab $oldg}
+                    }
+                    return
+                }
+            }
+        }
+    } else {
+        set oldg [::grab current]
+        if { $oldg != "" } {
+            lappend _gstack [list $oldg [::grab status $oldg]]
+        }
+        if { $option == "global" } {
+            ::grab -global $path
+        } else {
+            ::grab $path
+        }
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command BWidget::focus
+# ------------------------------------------------------------------------------
+proc BWidget::focus { option path } {
+    variable _fstack
+
+    if { $option == "release" } {
+        while { [llength $_fstack] } {
+            set oldf [lindex $_fstack end]
+            set _fstack [lreplace $_fstack end end]
+            if { [string compare $oldf $path] && [winfo exists $oldf] } {
+                catch {::focus -force $oldf}
+                return
+            }
+        }
+    } elseif { $option == "set" } {
+        lappend _fstack [::focus]
+        ::focus -force $path
+    }
+}

lib/external/bwidget/widget.tcl

@@ -0,0 +1,972 @@
+# ------------------------------------------------------------------------------
+#  widget.tcl
+#  This file is part of Unifix BWidget Toolkit
+#  $Id$
+# ------------------------------------------------------------------------------
+#  Index of commands:
+#     - Widget::tkinclude
+#     - Widget::bwinclude
+#     - Widget::declare
+#     - Widget::addmap
+#     - Widget::init
+#     - Widget::destroy
+#     - Widget::setoption
+#     - Widget::configure
+#     - Widget::cget
+#     - Widget::subcget
+#     - Widget::hasChanged
+#     - Widget::_get_tkwidget_options
+#     - Widget::_test_tkresource
+#     - Widget::_test_bwresource
+#     - Widget::_test_synonym
+#     - Widget::_test_string
+#     - Widget::_test_flag
+#     - Widget::_test_enum
+#     - Widget::_test_int
+#     - Widget::_test_boolean
+# ------------------------------------------------------------------------------
+
+namespace eval Widget {
+    variable _optiontype
+    variable _class
+    variable _tk_widget
+
+    array set _optiontype {
+        TkResource Widget::_test_tkresource
+        BwResource Widget::_test_bwresource
+        Enum       Widget::_test_enum
+        Int        Widget::_test_int
+        Boolean    Widget::_test_boolean
+        String     Widget::_test_string
+        Flag       Widget::_test_flag
+        Synonym    Widget::_test_synonym
+    }
+
+    proc use {} {}
+}
+
+
+
+# ------------------------------------------------------------------------------
+#  Command Widget::tkinclude
+#     Includes tk widget resources to BWidget widget.
+#  class      class name of the BWidget
+#  tkwidget   tk widget to include
+#  subpath    subpath to configure
+#  args       additionnal args for included options
+# ------------------------------------------------------------------------------
+proc Widget::tkinclude { class tkwidget subpath args } {
+    foreach {cmd lopt} $args {
+        # cmd can be
+        #   include      options to include            lopt = {opt ...}
+        #   remove       options to remove             lopt = {opt ...}
+        #   rename       options to rename             lopt = {opt newopt ...}
+        #   prefix       options to prefix             lopt = {prefix opt opt ...}
+        #   initialize   set default value for options lopt = {opt value ...}
+        #   readonly     set readonly flag for options lopt = {opt flag ...}
+        switch -- $cmd {
+            remove {
+                foreach option $lopt {
+                    set remove($option) 1
+                }
+            }
+            include {
+                foreach option $lopt {
+                    set include($option) 1
+                }
+            }
+            prefix {
+                set prefix [lindex $lopt 0]
+                foreach option [lrange $lopt 1 end] {
+                    set rename($option) "-$prefix[string range $option 1 end]"
+                }
+            }
+            rename     -
+            readonly   -
+            initialize {
+                array set $cmd $lopt
+            }
+            default {
+                return -code error "invalid argument \"$cmd\""
+            }
+        }
+    }
+
+    namespace eval $class {}
+    upvar 0 ${class}::opt classopt
+    upvar 0 ${class}::map classmap
+
+    # create resources informations from tk widget resources
+    foreach optdesc [_get_tkwidget_options $tkwidget] {
+        set option [lindex $optdesc 0]
+        if { (![info exists include] || [info exists include($option)]) &&
+             ![info exists remove($option)] } {
+            if { [llength $optdesc] == 3 } {
+                # option is a synonym
+                set syn [lindex $optdesc 1]
+                if { ![info exists remove($syn)] } {
+                    # original option is not removed
+                    if { [info exists rename($syn)] } {
+                        set classopt($option) [list Synonym $rename($syn)]
+                    } else {
+                        set classopt($option) [list Synonym $syn]
+                    }
+                }
+            } else {
+                if { [info exists rename($option)] } {
+                    set realopt $option
+                    set option  $rename($option)
+                } else {
+                    set realopt $option
+                }
+                if { [info exists initialize($option)] } {
+                    set value $initialize($option)
+                } else {
+                    set value [lindex $optdesc 1]
+                }
+                if { [info exists readonly($option)] } {
+                    set ro $readonly($option)
+                } else {
+                    set ro 0
+                }
+                set classopt($option) [list TkResource $value $ro [list $tkwidget $realopt]]
+                lappend classmap($option) $subpath "" $realopt
+            }
+        }
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Widget::bwinclude
+#     Includes BWidget resources to BWidget widget.
+#  class    class name of the BWidget
+#  subclass BWidget class to include
+#  subpath  subpath to configure
+#  args     additionnal args for included options
+# ------------------------------------------------------------------------------
+proc Widget::bwinclude { class subclass subpath args } {
+    foreach {cmd lopt} $args {
+        # cmd can be
+        #   include      options to include            lopt = {opt ...}
+        #   remove       options to remove             lopt = {opt ...}
+        #   rename       options to rename             lopt = {opt newopt ...}
+        #   prefix       options to prefix             lopt = {prefix opt opt ...}
+        #   initialize   set default value for options lopt = {opt value ...}
+        #   readonly     set readonly flag for options lopt = {opt flag ...}
+        switch -- $cmd {
+            remove {
+                foreach option $lopt {
+                    set remove($option) 1
+                }
+            }
+            include {
+                foreach option $lopt {
+                    set include($option) 1
+                }
+            }
+            prefix {
+                set prefix [lindex $lopt 0]
+                foreach option [lrange $lopt 1 end] {
+                    set rename($option) "-$prefix[string range $option 1 end]"
+                }
+            }
+            rename     -
+            readonly   -
+            initialize {
+                array set $cmd $lopt
+            }
+            default {
+                return -code error "invalid argument \"$cmd\""
+            }
+        }
+    }
+
+    namespace eval $class {}
+    upvar 0 ${class}::opt classopt
+    upvar 0 ${class}::map classmap
+    upvar 0 ${subclass}::opt subclassopt
+
+    # create resources informations from BWidget resources
+    foreach {option optdesc} [array get subclassopt] {
+        if { (![info exists include] || [info exists include($option)]) &&
+             ![info exists remove($option)] } {
+            set type [lindex $optdesc 0]
+            if { ![string compare $type "Synonym"] } {
+                # option is a synonym
+                set syn [lindex $optdesc 1]
+                if { ![info exists remove($syn)] } {
+                    if { [info exists rename($syn)] } {
+                        set classopt($option) [list Synonym $rename($syn)]
+                    } else {
+                        set classopt($option) [list Synonym $syn]
+                    }
+                }
+            } else {
+                if { [info exists rename($option)] } {
+                    set realopt $option
+                    set option  $rename($option)
+                } else {
+                    set realopt $option
+                }
+                if { [info exists initialize($option)] } {
+                    set value $initialize($option)
+                } else {
+                    set value [lindex $optdesc 1]
+                }
+                if { [info exists readonly($option)] } {
+                    set ro $readonly($option)
+                } else {
+                    set ro [lindex $optdesc 2]
+                }
+                set classopt($option) [list $type $value $ro [lindex $optdesc 3]]
+                lappend classmap($option) $subpath $subclass $realopt
+            }
+        }
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Widget::declare
+#    Declares new options to BWidget class.
+# ------------------------------------------------------------------------------
+proc Widget::declare { class optlist } {
+    variable _optiontype
+
+    namespace eval $class {}
+    upvar 0 ${class}::opt classopt
+
+    foreach optdesc $optlist {
+        set option  [lindex $optdesc 0]
+        set optdesc [lrange $optdesc 1 end]
+        set type    [lindex $optdesc 0]
+
+        if { ![info exists _optiontype($type)] } {
+            # invalid resource type
+            return -code error "invalid option type \"$type\""
+        }
+
+        if { ![string compare $type "Synonym"] } {
+            # test existence of synonym option
+            set syn [lindex $optdesc 1]
+            if { ![info exists classopt($syn)] } {
+                return -code error "unknow option \"$syn\" for Synonym \"$option\""
+            }
+            set classopt($option) [list Synonym $syn]
+            continue
+        }
+
+        # all other resource may have default value, readonly flag and
+        # optional arg depending on type
+        set value [lindex $optdesc 1]
+        set ro    [lindex $optdesc 2]
+        set arg   [lindex $optdesc 3]
+
+        if { ![string compare $type "BwResource"] } {
+            # We don't keep BwResource. We simplify to type of sub BWidget
+            set subclass    [lindex $arg 0]
+            set realopt     [lindex $arg 1]
+            if { ![string length $realopt] } {
+                set realopt $option
+            }
+
+            upvar 0 ${subclass}::opt subclassopt
+            if { ![info exists subclassopt($realopt)] } {
+                return -code error "unknow option \"$realopt\""
+            }
+            set suboptdesc $subclassopt($realopt)
+            if { $value == "" } {
+                # We initialize default value
+                set value [lindex $suboptdesc 1]
+            }
+            set type [lindex $suboptdesc 0]
+            set ro   [lindex $suboptdesc 2]
+            set arg  [lindex $suboptdesc 3]
+            set classopt($option) [list $type $value $ro $arg]
+            continue
+        }
+
+        # retreive default value for TkResource
+        if { ![string compare $type "TkResource"] } {
+            set tkwidget [lindex $arg 0]
+            set realopt  [lindex $arg 1]
+            if { ![string length $realopt] } {
+                set realopt $option
+            }
+            set tkoptions [_get_tkwidget_options $tkwidget]
+            if { ![string length $value] } {
+                # We initialize default value
+                set value [lindex [lindex $tkoptions [lsearch $tkoptions [list $realopt *]]] end]
+            }
+            set classopt($option) [list TkResource $value $ro [list $tkwidget $realopt]]
+            continue
+        }
+
+        # for any other resource type, we keep original optdesc
+        set classopt($option) [list $type $value $ro $arg]
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Widget::addmap
+# ------------------------------------------------------------------------------
+proc Widget::addmap { class subclass subpath options } {
+    upvar 0 ${class}::map classmap
+
+    foreach {option realopt} $options {
+        if { ![string length $realopt] } {
+            set realopt $option
+        }
+        lappend classmap($option) $subpath $subclass $realopt
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Widget::syncoptions
+# ------------------------------------------------------------------------------
+proc Widget::syncoptions { class subclass subpath options } {
+    upvar 0 ${class}::sync classync
+
+    foreach {option realopt} $options {
+        if { ![string length $realopt] } {
+            set realopt $option
+        }
+        set classync($option) [list $subpath $subclass $realopt]
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Widget::init
+# ------------------------------------------------------------------------------
+proc Widget::init { class path options } {
+    variable _class
+    variable _optiontype
+
+    upvar 0 ${class}::opt classopt
+    upvar 0 ${class}::map classmap
+    upvar 0 ${class}::$path:opt  pathopt
+    upvar 0 ${class}::$path:mod  pathmod
+
+    catch {unset pathopt}
+    catch {unset pathmod}
+    set fpath ".#BWidgetClass#$class"
+    regsub -all "::" $class "" rdbclass
+    if { ![winfo exists $fpath] } {
+        frame $fpath -class $rdbclass
+    }
+    foreach {option optdesc} [array get classopt] {
+        set type [lindex $optdesc 0]
+        if { ![string compare $type "Synonym"] } {
+            set option  [lindex $optdesc 1]
+            set optdesc $classopt($option)
+            set type    [lindex $optdesc 0]
+        }
+        if { ![string compare $type "TkResource"] } {
+            set alt [lindex [lindex $optdesc 3] 1]
+        } else {
+            set alt ""
+        }
+        set optdb [lindex [_configure_option $option $alt] 0]
+        set def   [option get $fpath $optdb $rdbclass]
+        if { [string length $def] } {
+            set pathopt($option) $def
+        } else {
+            set pathopt($option) [lindex $optdesc 1]
+        }
+        set pathmod($option) 0
+    }
+
+    set _class($path) $class
+    foreach {option value} $options {
+        if { ![info exists classopt($option)] } {
+            unset pathopt
+            unset pathmod
+            return -code error "unknown option \"$option\""
+        }
+        set optdesc $classopt($option)
+        set type    [lindex $optdesc 0]
+        if { ![string compare $type "Synonym"] } {
+            set option  [lindex $optdesc 1]
+            set optdesc $classopt($option)
+            set type    [lindex $optdesc 0]
+        }
+        set pathopt($option) [$_optiontype($type) $option $value [lindex $optdesc 3]]
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Widget::destroy
+# ------------------------------------------------------------------------------
+proc Widget::destroy { path } {
+    variable _class
+
+    set class $_class($path)
+    upvar 0 ${class}::$path:opt pathopt
+    upvar 0 ${class}::$path:mod pathmod
+
+    catch {unset pathopt}
+    catch {unset pathmod}
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Widget::configure
+# ------------------------------------------------------------------------------
+proc Widget::configure { path options } {
+    set len [llength $options]
+    if { $len <= 1 } {
+        return [_get_configure $path $options]
+    } elseif { $len % 2 == 1 } {
+        return -code error "incorrect number of arguments"
+    }
+
+    variable _class
+    variable _optiontype
+
+    set class $_class($path)
+    upvar 0 ${class}::opt  classopt
+    upvar 0 ${class}::map  classmap
+    upvar 0 ${class}::$path:opt pathopt
+    upvar 0 ${class}::$path:mod pathmod
+
+    set window [_get_window $class $path]
+    foreach {option value} $options {
+        if { ![info exists classopt($option)] } {
+            return -code error "unknown option \"$option\""
+        }
+        set optdesc $classopt($option)
+        set type    [lindex $optdesc 0]
+        if { ![string compare $type "Synonym"] } {
+            set option  [lindex $optdesc 1]
+            set optdesc $classopt($option)
+            set type    [lindex $optdesc 0]
+        }
+        if { ![lindex $optdesc 2] } {
+            set curval $pathopt($option)
+            set newval [$_optiontype($type) $option $value [lindex $optdesc 3]]
+            if { [info exists classmap($option)] } {
+                foreach {subpath subclass realopt} $classmap($option) {
+                    if { [string length $subclass] } {
+                        ${subclass}::configure $window$subpath $realopt $newval
+                    } else {
+                        $window$subpath configure $realopt $newval
+                    }
+                }
+            }
+            set pathopt($option) $newval
+            set pathmod($option) [expr {[string compare $newval $curval] != 0}]
+        }
+    }
+
+    return {}
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Widget::cget
+# ------------------------------------------------------------------------------
+proc Widget::cget { path option } {
+    variable _class
+
+    if { ![info exists _class($path)] } {
+        return -code error "unknown widget $path"
+    }
+
+    set class $_class($path)
+    upvar 0 ${class}::opt  classopt
+    upvar 0 ${class}::sync classync
+    upvar 0 ${class}::$path:opt pathopt
+
+    if { ![info exists classopt($option)] } {
+        return -code error "unknown option \"$option\""
+    }
+    set optdesc $classopt($option)
+    set type    [lindex $optdesc 0]
+    if { ![string compare $type "Synonym"] } {
+        set option [lindex $optdesc 1]
+    }
+
+    if { [info exists classync($option)] } {
+        set window [_get_window $class $path]
+        foreach {subpath subclass realopt} $classync($option) {
+            if { [string length $subclass] } {
+                set pathopt($option) [${subclass}::cget $window$subpath $realopt]
+            } else {
+                set pathopt($option) [$window$subpath cget $realopt]
+            }
+        }
+    }
+
+    return $pathopt($option)
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Widget::subcget
+# ------------------------------------------------------------------------------
+proc Widget::subcget { path subwidget } {
+    variable _class
+
+    set class $_class($path)
+    upvar 0 ${class}::map classmap
+    upvar 0 ${class}::$path:opt pathopt
+
+    set result {}
+    foreach {option map} [array get classmap] {
+        foreach {subpath subclass realopt} $map {
+            if { ![string compare $subpath $subwidget] } {
+                lappend result $realopt $pathopt($option)
+            }
+        }
+    }
+    return $result
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Widget::hasChanged
+# ------------------------------------------------------------------------------
+proc Widget::hasChanged { path option pvalue } {
+    upvar    $pvalue value
+    variable _class
+
+    set class $_class($path)
+    upvar 0 ${class}::$path:opt pathopt
+    upvar 0 ${class}::$path:mod pathmod
+
+    set value   $pathopt($option)
+    set result  $pathmod($option)
+    set pathmod($option) 0
+
+    return $result
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Widget::setoption
+# ------------------------------------------------------------------------------
+proc Widget::setoption { path option value } {
+    variable _class
+
+    set class $_class($path)
+    upvar 0 ${class}::$path:opt pathopt
+
+    set pathopt($option) $value
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Widget::getoption
+# ------------------------------------------------------------------------------
+proc Widget::getoption { path option } {
+    variable _class
+
+    set class $_class($path)
+    upvar 0 ${class}::$path:opt pathopt
+
+    return $pathopt($option)
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Widget::_get_window
+#  returns the window corresponding to widget path
+# ------------------------------------------------------------------------------
+proc Widget::_get_window { class path } {
+    set idx [string last "#" $path]
+    if { $idx != -1 && ![string compare [string range $path [expr {$idx+1}] end] $class] } {
+        return [string range $path 0 [expr {$idx-1}]]
+    } else {
+        return $path
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Widget::_get_configure
+#  returns the configuration list of options
+#  (as tk widget do - [$w configure ?option?])
+# ------------------------------------------------------------------------------
+proc Widget::_get_configure { path options } {
+    variable _class
+
+    set class $_class($path)
+    upvar 0 ${class}::opt classopt
+    upvar 0 ${class}::map classmap
+    upvar 0 ${class}::$path:opt pathopt
+    upvar 0 ${class}::$path:mod pathmod
+
+    set len [llength $options]
+    if { !$len } {
+        set result {}
+        foreach option [lsort [array names classopt]] {
+            set optdesc $classopt($option)
+            set type    [lindex $optdesc 0]
+            if { ![string compare $type "Synonym"] } {
+                set syn     $option
+                set option  [lindex $optdesc 1]
+                set optdesc $classopt($option)
+                set type    [lindex $optdesc 0]
+            } else {
+                set syn ""
+            }
+            if { ![string compare $type "TkResource"] } {
+                set alt [lindex [lindex $optdesc 3] 1]
+            } else {
+                set alt ""
+            }
+            set res [_configure_option $option $alt]
+            if { $syn == "" } {
+                lappend result [concat $option $res [list [lindex $optdesc 1]] [list [cget $path $option]]]
+            } else {
+                lappend result [list $syn [lindex $res 0]]
+            }
+        }
+        return $result
+    } elseif { $len == 1 } {
+        set option  [lindex $options 0]
+        if { ![info exists classopt($option)] } {
+            return -code error "unknown option \"$option\""
+        }
+        set optdesc $classopt($option)
+        set type    [lindex $optdesc 0]
+        if { ![string compare $type "Synonym"] } {
+            set option  [lindex $optdesc 1]
+            set optdesc $classopt($option)
+            set type    [lindex $optdesc 0]
+        }
+        if { ![string compare $type "TkResource"] } {
+            set alt [lindex [lindex $optdesc 3] 1]
+        } else {
+            set alt ""
+        }
+        set res [_configure_option $option $alt]
+        return [concat $option $res [list [lindex $optdesc 1]] [list [cget $path $option]]]
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Widget::_configure_option
+# ------------------------------------------------------------------------------
+proc Widget::_configure_option { option altopt } {
+    variable _optiondb
+    variable _optionclass
+
+    if { [info exists _optiondb($option)] } {
+        set optdb $_optiondb($option)
+    } else {
+        set optdb [string range $option 1 end]
+    }
+    if { [info exists _optionclass($option)] } {
+        set optclass $_optionclass($option)
+    } elseif { [string length $altopt] } {
+        if { [info exists _optionclass($altopt)] } {
+            set optclass $_optionclass($altopt)
+        } else {
+            set optclass [string range $altopt 1 end]
+        }
+    } else {
+        set optclass [string range $option 1 end]
+    }
+    return [list $optdb $optclass]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Widget::_get_tkwidget_options
+# ------------------------------------------------------------------------------
+proc Widget::_get_tkwidget_options { tkwidget } {
+    variable _tk_widget
+    variable _optiondb
+    variable _optionclass
+
+    if { ![info exists _tk_widget($tkwidget)] } {
+        set widget [$tkwidget ".#BWidget#$tkwidget"]
+        set config [$widget configure]
+        foreach optlist $config {
+            set opt [lindex $optlist 0]
+            if { [llength $optlist] == 2 } {
+                set refsyn [lindex $optlist 1]
+                # search for class
+                set idx [lsearch $config [list * $refsyn *]]
+                if { $idx == -1 } {
+                    if { [string index $refsyn 0] == "-" } {
+                        # search for option (tk8.1b1 bug)
+                        set idx [lsearch $config [list $refsyn * *]]
+                    } else {
+                        # last resort
+                        set idx [lsearch $config [list -[string tolower $refsyn] * *]]
+                    }
+                    if { $idx == -1 } {
+                        # fed up with "can't read classopt()"
+                        return -code error "can't find option of synonym $opt"
+                    }
+                }
+                set syn [lindex [lindex $config $idx] 0]
+                set def [lindex [lindex $config $idx] 3]
+                lappend _tk_widget($tkwidget) [list $opt $syn $def]
+            } else {
+                set def [lindex $optlist 3]
+                lappend _tk_widget($tkwidget) [list $opt $def]
+                set _optiondb($opt)    [lindex $optlist 1]
+                set _optionclass($opt) [lindex $optlist 2]
+            }
+        }
+    }
+    return $_tk_widget($tkwidget)
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Widget::_test_tkresource
+# ------------------------------------------------------------------------------
+proc Widget::_test_tkresource { option value arg } {
+    set tkwidget [lindex $arg 0]
+    set realopt  [lindex $arg 1]
+    set path     ".#BWidget#$tkwidget"
+    set old      [$path cget $realopt]
+    $path configure $realopt $value
+    set res      [$path cget $realopt]
+    $path configure $realopt $old
+
+    return $res
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Widget::_test_bwresource
+# ------------------------------------------------------------------------------
+proc Widget::_test_bwresource { option value arg } {
+    return -code error "bad option type BwResource in widget"
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Widget::_test_synonym
+# ------------------------------------------------------------------------------
+proc Widget::_test_synonym { option value arg } {
+    return -code error "bad option type Synonym in widget"
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Widget::_test_string
+# ------------------------------------------------------------------------------
+proc Widget::_test_string { option value arg } {
+    return $value
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Widget::_test_flag
+# ------------------------------------------------------------------------------
+proc Widget::_test_flag { option value arg } {
+    set len [string length $value]
+    set res ""
+    for {set i 0} {$i < $len} {incr i} {
+        set c [string index $value $i]
+        if { [string first $c $arg] == -1 } {
+            return -code error "bad [string range $option 1 end] value \"$value\": characters must be in \"$arg\""
+        }
+        if { [string first $c $res] == -1 } {
+            append res $c
+        }
+    }
+    return $res
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Widget::_test_enum
+# ------------------------------------------------------------------------------
+proc Widget::_test_enum { option value arg } {
+    if { [lsearch $arg $value] == -1 } {
+        set last [lindex   $arg end]
+        set sub  [lreplace $arg end end]
+        if { [llength $sub] } {
+            set str "[join $sub ", "] or $last"
+        } else {
+            set str $last
+        }
+        return -code error "bad [string range $option 1 end] value \"$value\": must be $str"
+    }
+    return $value
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Widget::_test_int
+# ------------------------------------------------------------------------------
+proc Widget::_test_int { option value arg } {
+    set binf [lindex $arg 0]
+    set bsup [lindex $arg 1]
+    if { $binf != "" } {set binf ">$binf"}
+    if { $bsup != "" } {set bsup "<$bsup"}
+    if { [catch {expr $value}] || $value != int($value) ||
+         !($binf == "" || [expr $value$binf]) ||
+         !($bsup == "" || [expr $value$bsup]) } {
+        return -code error "bad [string range $option 1 end] value \"$value\": must be integer $binf $bsup"
+    }
+    return $value
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Widget::_test_boolean
+# ------------------------------------------------------------------------------
+proc Widget::_test_boolean { option value arg } {
+    if { $value == 1 ||
+         ![string compare $value "true"] ||
+         ![string compare $value "yes"] } {
+        set value 1
+    } elseif { $value == 0 ||
+               ![string compare $value "false"] ||
+               ![string compare $value "no"] } {
+        set value 0
+    } else {
+        return -code error "bad [string range $option 1 end] value \"$value\": must be boolean"
+    }
+    return $value
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Widget::focusNext
+#  Same as tk_focusNext, but call Widget::focusOK
+# ------------------------------------------------------------------------------
+proc Widget::focusNext { w } {
+    set cur $w
+    while 1 {
+
+	# Descend to just before the first child of the current widget.
+
+	set parent $cur
+	set children [winfo children $cur]
+	set i -1
+
+	# Look for the next sibling that isn't a top-level.
+
+	while 1 {
+	    incr i
+	    if {$i < [llength $children]} {
+		set cur [lindex $children $i]
+		if {[winfo toplevel $cur] == $cur} {
+		    continue
+		} else {
+		    break
+		}
+	    }
+
+	    # No more siblings, so go to the current widget's parent.
+	    # If it's a top-level, break out of the loop, otherwise
+	    # look for its next sibling.
+
+	    set cur $parent
+	    if {[winfo toplevel $cur] == $cur} {
+		break
+	    }
+	    set parent [winfo parent $parent]
+	    set children [winfo children $parent]
+	    set i [lsearch -exact $children $cur]
+	}
+	if {($cur == $w) || [focusOK $cur]} {
+	    return $cur
+	}
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Widget::focusPrev
+#  Same as tk_focusPrev, but call Widget::focusOK
+# ------------------------------------------------------------------------------
+proc Widget::focusPrev { w } {
+    set cur $w
+    while 1 {
+
+	# Collect information about the current window's position
+	# among its siblings.  Also, if the window is a top-level,
+	# then reposition to just after the last child of the window.
+    
+	if {[winfo toplevel $cur] == $cur}  {
+	    set parent $cur
+	    set children [winfo children $cur]
+	    set i [llength $children]
+	} else {
+	    set parent [winfo parent $cur]
+	    set children [winfo children $parent]
+	    set i [lsearch -exact $children $cur]
+	}
+
+	# Go to the previous sibling, then descend to its last descendant
+	# (highest in stacking order.  While doing this, ignore top-levels
+	# and their descendants.  When we run out of descendants, go up
+	# one level to the parent.
+
+	while {$i > 0} {
+	    incr i -1
+	    set cur [lindex $children $i]
+	    if {[winfo toplevel $cur] == $cur} {
+		continue
+	    }
+	    set parent $cur
+	    set children [winfo children $parent]
+	    set i [llength $children]
+	}
+	set cur $parent
+	if {($cur == $w) || [focusOK $cur]} {
+	    return $cur
+	}
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command Widget::focusOK
+#  Same as tk_focusOK, but handles -editable option and whole tags list.
+# ------------------------------------------------------------------------------
+proc Widget::focusOK { w } {
+    set code [catch {$w cget -takefocus} value]
+    if { $code == 1 } {
+        return 0
+    }
+    if {($code == 0) && ($value != "")} {
+	if {$value == 0} {
+	    return 0
+	} elseif {$value == 1} {
+	    return [winfo viewable $w]
+	} else {
+	    set value [uplevel \#0 $value $w]
+            if {$value != ""} {
+		return $value
+	    }
+        }
+    }
+    if {![winfo viewable $w]} {
+	return 0
+    }
+    set code [catch {$w cget -state} value]
+    if {($code == 0) && ($value == "disabled")} {
+	return 0
+    }
+    set code [catch {$w cget -editable} value]
+    if {($code == 0) && !$value} {
+        return 0
+    }
+
+    set top [winfo toplevel $w]
+    foreach tags [bindtags $w] {
+        if { [string compare $tags $top]  &&
+             [string compare $tags "all"] &&
+             [regexp Key [bind $tags]] } {
+            return 1
+        }
+    }
+    return 0
+}

lib/external/bwidget/xpm2image.tcl

@@ -0,0 +1,115 @@
+# ------------------------------------------------------------------------------
+#  xpm2image.tcl
+#  Slightly modified xpm-to-image command
+#  $Id$
+# ------------------------------------------------------------------------------
+#
+#  Copyright 1996 by Roger E. Critchlow Jr., San Francisco, California
+#  All rights reserved, fair use permitted, caveat emptor.
+#  rec@elf.org
+# 
+# ------------------------------------------------------------------------------
+
+proc xpm-to-image { file } {
+    set f [open $file]
+    set string [read $f]
+    close $f
+
+    #
+    # parse the strings in the xpm data
+    #
+    set xpm {}
+    foreach line [split $string "\n"] {
+        if {[regexp {^"([^\"]*)"} $line all meat]} {
+            if {[string first XPMEXT $meat] == 0} {
+                break
+            }
+            lappend xpm $meat
+        }
+    }
+    #
+    # extract the sizes in the xpm data
+    #
+    set sizes  [lindex $xpm 0]
+    set nsizes [llength $sizes]
+    if { $nsizes == 4 || $nsizes == 6 || $nsizes == 7 } {
+        set data(width)   [lindex $sizes 0]
+        set data(height)  [lindex $sizes 1]
+        set data(ncolors) [lindex $sizes 2]
+        set data(chars_per_pixel) [lindex $sizes 3]
+        set data(x_hotspot) 0
+        set data(y_hotspot) 0
+        if {[llength $sizes] >= 6} {
+            set data(x_hotspot) [lindex $sizes 4]
+            set data(y_hotspot) [lindex $sizes 5]
+        }
+    } else {
+	    error "size line {$sizes} in $file did not compute"
+    }
+
+    #
+    # extract the color definitions in the xpm data
+    #
+    foreach line [lrange $xpm 1 $data(ncolors)] {
+        set colors [split $line \t]
+        set cname  [lindex $colors 0]
+        lappend data(cnames) $cname
+        if { [string length $cname] != $data(chars_per_pixel) } {
+            error "color definition {$line} in file $file has a bad size color name"
+        }
+        foreach record [lrange $colors 1 end] {
+            set key [lindex $record 0]
+            set color [string tolower [join [lrange $record 1 end] { }]]
+            set data(color-$key-$cname) $color
+            if { ![string compare $color "none"] } {
+                set data(transparent) $cname
+            }
+        }
+        foreach key {c g g4 m} {
+            if {[info exists data(color-$key-$cname)]} {
+                set color $data(color-$key-$cname)
+                set data(color-$cname) $color
+                set data(cname-$color) $cname
+                lappend data(colors) $color
+                break
+            }
+        }
+        if { ![info exists data(color-$cname)] } {
+            error "color definition {$line} in $file failed to define a color"
+        }
+    }
+
+    #
+    # extract the image data in the xpm data
+    #
+    set image [image create photo -width $data(width) -height $data(height)]
+    set y 0
+    foreach line [lrange $xpm [expr 1+$data(ncolors)] [expr 1+$data(ncolors)+$data(height)]] {
+        set x 0
+        set pixels {}
+        while { [string length $line] > 0 } {
+            set pixel [string range $line 0 [expr {$data(chars_per_pixel)-1}]]
+            set c $data(color-$pixel)
+            if { ![string compare $c none] } {
+                if { [string length $pixels] } {
+                    $image put [list $pixels] -to [expr {$x-[llength $pixels]}] $y
+                    set pixels {}
+                }
+            } else {
+                lappend pixels $c
+            }
+            set line [string range $line $data(chars_per_pixel) end]
+            incr x
+        }
+        if { [llength $pixels] } {
+            $image put [list $pixels] -to [expr {$x-[llength $pixels]}] $y
+        }
+        incr y
+    }
+
+    #
+    # return the image
+    #
+    return $image
+}
+

lib/gtcltk/Makefile

@@ -0,0 +1,11 @@
+MODULE_TOPDIR = ../..
+
+PGM=grocat
+include $(MODULE_TOPDIR)/include/Make/Etc.make
+include $(MODULE_TOPDIR)/include/Make/NoHtml.make
+
+default: etc $(ETC)/gtcltk
+
+$(ETC)/gtcltk: *.tcl 
+	if [ ! -d $(ETC)/gtcltk ]; then $(MKDIR) $(ETC)/gtcltk; fi
+	for file in *.tcl ; do $(INSTALL_DATA) $$file $(ETC)/gtcltk/ ; done

lib/gtcltk/gmsg.tcl

@@ -0,0 +1,27 @@
+#############################################################################
+#
+# gmsg.tcl
+#
+# MODULE:   	Grass Tcl/Tk I18n wrapper
+# AUTHOR(S):	Alex Shevlakov alex@motivation.ru
+# PURPOSE:  	I18N Tcl-Tk based GUI text strings wrapper procedure
+#
+# COPYRIGHT:    (C) 2000 by the GRASS Development Team
+#
+#               This program is free software under the GNU General Public
+#   	    	License (>=v2). Read the file COPYING that comes with GRASS
+#   	    	for details.
+#
+#############################################################################
+
+
+if [catch {package require msgcat}] {
+	proc G_msg {message} {
+		return $message
+	}
+} else {
+	::msgcat::mcload $env(GISBASE)/etc/msgs
+	proc G_msg {message} {
+		return [::msgcat::mc $message]
+	}
+}

lib/gtcltk/grocat.c

@@ -0,0 +1,50 @@
+
+/****************************************************************************
+ *
+ * MODULE:       grocat
+ * AUTHOR(S):    Paul Kelly
+ * PURPOSE:      Copies stdin to stdout in line-buffered mode until end
+ *               of file is received.
+ *               Used with Tcl/Tk gronsole system to merge stdout and
+ *               stderr streams to be caught by Tcl "open" command.
+ * COPYRIGHT:    (C) 2006 by the GRASS Development Team
+ *
+ *               This program is free software under the GNU General Public
+ *               License (>=v2). Read the file COPYING that comes with GRASS
+ *               for details.
+ *
+ *****************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+
+int main(void)
+{
+    int inchar, outchar;
+    char inbuff[1024], outbuff[1024];
+
+    /* stdin and stdout both line-buffered */
+    if (setvbuf(stdin, inbuff, _IOLBF, sizeof(inbuff))) {
+	fprintf(stderr, "grocat: Can't set stdin to line-buffered mode!\n");
+	exit(EXIT_FAILURE);
+    }
+    if (setvbuf(stdout, outbuff, _IOLBF, sizeof(outbuff))) {
+	fprintf(stderr, "grocat: Can't set stdout to line-buffered mode!\n");
+	exit(EXIT_FAILURE);
+    }
+
+    while ((inchar = getc(stdin)) != EOF) {
+	/* Read a character at a time from stdin until EOF
+	 * and copy to stdout */
+	outchar = putc(inchar, stdout);
+	if (outchar != inchar) {
+	    fprintf(stderr, "grocat: Error writing to stdout!\n");
+	    exit(EXIT_FAILURE);
+	}
+    }
+
+    /* Flush in case last line wasn't terminated properly or something */
+    fflush(stdout);
+
+    exit(EXIT_SUCCESS);
+}

lib/gtcltk/gronsole.tcl

@@ -0,0 +1,531 @@
+
+############################################################################
+#
+# LIBRARY:      Gronsole program run and output widget
+# AUTHOR(S):    Cedric Shock (cedricgrass AT shockfamily.net)
+#               Based on lib/gis/gui.tcl
+# PURPOSE:      Runs programs, displays output
+# COPYRIGHT:    (C) 2006 Grass Development Team
+#
+#               This program is free software under the GNU General Public
+#               License (>=v2). Read the file COPYING that comes with GRASS
+#               for details.
+#
+#############################################################################
+
+namespace eval Gronsole {
+	variable _data
+	variable _options
+
+	set _options [list [list -clickcmd clickCmd ClickCmd {} {}]]
+
+	proc ::Gronsole { path args } { return [eval Gronsole::create $path $args] }
+	proc use {} {}
+}
+
+proc Gronsole::dooptions {path args init} {
+	variable _data
+	variable _options
+	
+	foreach opt $_options {
+		set sw [lindex $opt 0]
+		set db [lindex $opt 1]
+		set def [lindex $opt 4]
+		if {[set idx [lsearch -exact $args $sw]] != -1} {
+			set _data($path,$db) [lindex $args [expr $idx + 1]]
+			set args [concat [lrange $args 0 [expr $idx - 1]] [lrange $args [expr $idx + 2] end]]
+		} elseif {$init} {
+			set _data($path,$db) $def
+		}
+	}
+}
+
+proc Gronsole::create {path args} {
+	global keycontrol
+	global bgcolor
+	variable _data
+
+	set args [Gronsole::dooptions $path $args 1]
+
+	set gronsolewin [ScrolledWindow $path -relief flat -borderwidth 1 -auto horizontal]
+	set gronsole [eval text $gronsolewin.text $args]
+	$gronsolewin setwidget $gronsole	
+
+
+	set _data($path,count) 0
+
+	bind $path.text <Destroy>   "Gronsole::_destroy $path"
+	bind $path.text <$keycontrol-c> "tk_textCopy %W"
+	bind $path.text <$keycontrol-v> "tk_textPaste %W"
+	bind $path.text <$keycontrol-x> "tk_textCut %W"
+
+	rename $path ::$path:scrollwin
+	proc ::$path { cmd args } "return \[eval Gronsole::\$cmd $path \$args\]"
+	return $path
+}
+
+proc Gronsole::configure { path args } {
+	variable _options
+	variable _data
+	if {$args == {}} {
+		set res {}
+		foreach opt $_options {
+			set sw [lindex $opt 0]
+			set db [lindex $opt 1]
+			set title [lindex $opt 2]
+			lappend res [list $sw $db $title $_data($path,$db) $_data($path,$db)]
+		}
+		return [concat $res [$path.text configure]]
+	}
+
+	set args [Gronsole::dooptions $path $args 0]
+	
+	$path.text configure $args
+
+	return
+}
+
+
+proc Gronsole::cget { path option } {
+    variable _options
+    variable _data
+    if {[lsearch -exact $_options $option] != -1} {
+        set res $_data($path,$option)
+    } else {
+        set res [$path.text cget $option]
+    }
+    return $res
+}
+
+proc Gronsole::_destroy { path } {
+    variable _data
+
+    array unset _data "$path,*"
+
+    catch {rename $path {}}
+}
+
+##########################################################################
+# Public contents management
+
+proc Gronsole::clear {path} {
+	variable _data
+
+	$path.text delete 1.0 end
+}
+
+
+# save text in output window
+proc Gronsole::save {path} {
+	global env
+
+	set dtxt $path.text
+
+	if ![catch {$dtxt get sel.first}] {
+		set svtxt [$dtxt get sel.first sel.last]
+	} else {
+		set svtxt [$dtxt get 1.0 end]
+	} 
+	
+	set types {
+     {{TXT} {.txt}}
+	}
+
+	if { [info exists HOME] } {
+		set dir $env(HOME)
+		set path [tk_getSaveFile -initialdir $dir -filetypes $types \
+			-defaultextension ".txt"]
+	} else {
+		set path [tk_getSaveFile -filetypes $types \
+			-defaultextension ".txt"]
+	}
+
+	if { $path == "" } { return }
+
+	set txtfile [open $path w]
+	puts $txtfile $svtxt
+	close $txtfile
+	return
+}
+
+proc Gronsole::destroy_command {path ci} {
+	variable _data
+
+	catch {close $_data($path,$ci,fh)} 
+
+	if {[info exists _data($path,$ci,donecmd)] && $_data($path,$ci,donecmd) != {}} {
+		eval $_data($path,$ci,donecmd)
+	}
+
+	set textarea $path.text
+	set frame $_data($path,$ci,frame)
+
+	set indices [$textarea tag ranges cmd$ci]
+
+	eval $textarea delete $indices
+
+	destroy $frame
+
+	array unset _data "$path,$ci,*"
+}
+
+##########################################################################
+# Private
+
+proc Gronsole::do_click {path ci} {
+	variable _data
+
+	# Use this commands click command if it exists
+	if {[info exists _data($path,$ci,clickCmd)]} {
+		set cc $_data($path,$ci,clickCmd)
+	} else {
+		set cc $_data($path,clickCmd)
+	}
+	if {$cc != {}} {
+		eval $cc $ci [list $_data($path,$ci,cmd)]
+	}
+}
+
+proc Gronsole::create_command {path cmd} {
+	variable _data
+	set textarea $path.text
+
+	incr _data($path,count)
+	set ci $_data($path,count)
+	set _data($path,$ci,cmd) $cmd
+	
+	set module [lindex $cmd 0]
+	set icon [icon module $module]
+
+	set frame $textarea.cmd$ci
+
+	set _data($path,$ci,frame) $frame
+	
+	frame $frame 
+	frame $frame.cmdline
+	set tagframe [frame $frame.cmdline.tags]
+	set cmdlabel [label $frame.cmdline.cmd -textvariable Gronsole::_data($path,$ci,cmd) -anchor nw]
+	bind $cmdlabel <Button-1> "Gronsole::do_click $path $ci"
+	# set cmdlabel [text $frame.cmdline.cmd -height 1 -width 10]
+	# $cmdlabel insert end $cmd
+	set ex [button $frame.cmdline.eX -text "X" -command "Gronsole::destroy_command $path $ci"]
+	pack $ex -side right
+	pack $frame.cmdline.tags -side right
+	set iconwidth ""
+	if {$icon != 0} {
+		set iconwidth " - \[winfo width $frame.cmdline.icon\]"
+		button $frame.cmdline.icon -image $icon -anchor n -command "Gronsole::do_click $path $ci"
+		pack $frame.cmdline.icon -side left
+	}
+	pack $frame.cmdline.cmd -side left -expand yes -fill x
+	pack $frame.cmdline -side top -expand yes -fill x
+	set pbar [ProgressBar $frame.progress -fg green -bg white -height 20 -relief raised \
+		-maximum 100 -variable Gronsole::_data($path,$ci,progress)] 
+	pack $pbar -side left
+	set _data($path,$ci,progress) -1
+	set _data($path,$ci,progressbar) $pbar
+	set _data($path,$ci,tags) {}
+
+	$textarea insert end "\n" [list cmd$ci e1]
+	$textarea insert end "\n" [list cmd$ci e2]
+	$textarea mark set cmdinsert$ci "end - 2 char"
+
+	$textarea window create cmdinsert$ci -window $frame
+	$textarea tag add cmd$ci $frame
+	$textarea insert cmdinsert$ci "$cmd\n" [list cmd$ci e2]
+	# $textarea tag add cmd$ci "cmdinsert$ci - 1 char"
+	# $textarea tag add e2 "cmdinsert$ci - 1 char"
+
+	$textarea tag configure e1 -elide 1
+	$textarea tag configure e2 -elide 1
+
+
+	set pspace 12
+	$pbar configure -width [expr [winfo width $textarea] - $pspace]
+#	$pbar configure -width [expr [winfo width $textarea] - $pspace] -height 20
+
+	bind $textarea <Configure> "+catch {$pbar configure -width \[expr \[winfo width $textarea\] - $pspace\]}"
+
+
+	bind $textarea <Configure> "+catch {$cmdlabel configure -wraplength \[expr \[winfo width $textarea\] - $pspace - \[winfo width $tagframe\] - \[winfo width $ex\] $iconwidth\]}"
+
+	# bind $cmdlabel <Configure> "$cmdlabel configure -wraplength \[winfo width $cmdlabel\]"
+
+	return $ci
+}
+
+##########################################################################
+# Public tag management. add_data_tag is private
+
+proc Gronsole::set_click_command {path ci cmd} {
+	variable _data
+	set _data($path,$ci,clickCmd) $cmd
+}
+
+proc Gronsole::show_hide_tag_data {path ci tag} {
+	variable _data
+	set textarea $path.text
+	
+	set e [$textarea tag cget cmd$ci-$tag -elide]
+	if {$e == {}} {
+		$textarea tag configure cmd$ci-$tag -elide 1
+	} else {
+		$textarea tag configure cmd$ci-$tag -elide {}
+	}
+}
+
+proc Gronsole::add_tag {path ci tag} {
+	variable _data
+	set textarea $path.text
+	set frame $_data($path,$ci,frame)
+	if {[lsearch -exact $_data($path,$ci,tags) $tag] != -1} {
+		return
+	}
+	lappend _data($path,$ci,tags) $tag
+	button $frame.cmdline.tags.tag$tag -text $tag -relief flat
+	set icon [icon status $tag]
+	if {$icon != 0} {
+		$frame.cmdline.tags.tag$tag configure -image $icon
+	}
+	pack $frame.cmdline.tags.tag$tag -side right
+}
+
+# This is private:
+proc Gronsole::add_data_tag {path ci tag} {
+	variable _data
+	set textarea $path.text
+	set frame $_data($path,$ci,frame)
+	if {[lsearch -exact $_data($path,$ci,tags) $tag] != -1} {
+		return
+	}
+	Gronsole::add_tag $path $ci $tag
+	$frame.cmdline.tags.tag$tag configure -relief raised -command "Gronsole::show_hide_tag_data $path $ci $tag"
+}
+
+proc Gronsole::remove_tag {path ci tag} {
+	variable _data
+	set frame $_data($path,$ci,frame)
+	pack forget $frame.cmdline.tags.tag$tag
+	# destroy $frame.cmdline.tags.tag$tag	
+}
+
+
+##########################################################################
+# Private (stuff done when commands are run)
+
+# This procedure doesn't really seem necessary. I've left it in
+# in case there is something I'm missing (M. Barton 29 April 2007)
+proc Gronsole::progress {path ci percent} {
+	variable _data
+
+	if {[info exists _data($path,$ci,progress)]} {
+		set _data($path,$ci,progress) $percent
+	}
+	if {[info exists _data($path,$ci,progressbar)]} {
+		set pbar $_data($path,$ci,progressbar)
+	}
+
+	if {$percent == -1} {
+		$pbar configure -height 1
+	} else {
+		$pbar configure -height 20
+	}
+	# it seems that there is a bug in ProgressBar and it is not always updated ->
+	$pbar _modify
+}
+
+proc Gronsole::output_to_gronsole {path mark ci tags str} {
+	set outtext $path.text
+
+	set tagbase cmd$ci
+	# Back out backspaces:
+	if {0} {
+	while {[set idx [string first "\b" $str]] != -1} {
+		set last [expr $idx - 1]
+		set str1 [string range $str 1 $last]
+		set first [expr $idx + 1]
+		set str [string range $str $first end]
+		set pos [$outtext index "$mark - 1 chars"]
+		$outtext delete $pos
+		$outtext insert $mark $str1 $tags
+	}
+	}
+	if { [regexp -- {^GRASS_INFO_([^(]+)\(([0-9]+),([0-9]+)\): (.+)$} $str match key message_pid message_id val rest] } {
+		set lkey [string tolower $key]
+		Gronsole::add_tag $path $ci $lkey
+		set icon [icon status $lkey]
+		if {$icon != 0} {
+			$outtext image create $mark -image $icon
+			# $outtext tag add $tagbase "$mark -1 char"
+		}
+		$outtext insert $mark $val $tagbase
+	} elseif { [regexp -- {^GRASS_INFO_PERCENT: (.+)$} $str match val rest] } {
+		if { $val > 0 && $val < 100} { 
+			set Gronsole::_data($path,$ci,progress) $val
+#			Gronsole::progress $path $ci $val
+		} else {
+#			Gronsole::progress $path $ci -1
+			set Gronsole::_data($path,$ci,progress) -1
+			$outtext insert $mark "\n" $tags
+		}
+	} elseif { [regexp -- {^GRASS_INFO_END.+} $str match key rest] } {
+		# nothing
+	} else {
+		$outtext insert $mark $str $tags
+	}
+}
+
+proc Gronsole::readeof {path ci mark fh} {
+	variable _data
+	# This doesn't actually get the result
+	set result [catch {close $fh} error_text]
+	set _data($path,$ci,result) $result
+	# if {$result == 0} {
+		# Gronsole::add_tag $path $ci success
+		# set donecmd $_data($path,$ci,successcmd)
+	#} else {
+		# Gronsole::add_tag $path $ci failure
+		# set donecmd $_data($path,$ci,failurecmd)
+	#}
+	Gronsole::remove_tag $path $ci running
+}
+
+proc Gronsole::readout {path ci mark fh} {
+
+	set lines {}
+	
+	while {[gets $fh line] >= 0} {
+		lappend lines $line
+	}
+	
+	if {[llength $lines] != 0} {
+		Gronsole::add_data_tag $path $ci out
+	}
+	foreach line $lines {
+		Gronsole::output_to_gronsole $path $mark $ci [list cmd$ci cmd$ci-out] "$line\n"
+	}
+	$path.text see $mark
+}
+
+proc Gronsole::done_command {path ci} {
+	variable _data
+
+	if {[info exists _data($path,$ci,donecmd)] && $_data($path,$ci,donecmd) != {}} {
+		set donecmd $_data($path,$ci,donecmd)
+		set _data($path,$ci,donecmd) {}
+	}
+
+	if {[info exists donecmd] && $donecmd != {}} {
+		eval $donecmd
+	}
+}
+
+proc Gronsole::file_callback {path ci mark fh} {
+	if [eof $fh] {
+		Gronsole::readeof $path $ci $mark $fh
+		Gronsole::done_command $path $ci
+	} else {
+		Gronsole::readout $path $ci $mark $fh
+	}
+}
+
+proc Gronsole::execbg {path ci mark fh} {
+	fconfigure $fh -blocking 0
+	fileevent $fh readable [list Gronsole::file_callback $path $ci $mark $fh]
+}
+
+proc Gronsole::execwait {path ci mark fh} {
+	while {! [eof $fh]} {
+		Gronsole::readout $path $ci $mark $fh
+		update
+	}
+	Gronsole::readeof $path $ci $mark $fh
+	update
+}
+
+proc Gronsole::execout {path cmd ci execcmd} {
+	global env
+
+	set mark cmdinsert$ci
+
+	# Actually run the program
+	# |& grocat merges stdout and stderr because Tcl treats
+	# anything written to stderr as an error condition
+	set cmd [concat | $cmd |& $env(GISBASE)/etc/grocat]
+
+	set message_env [exec g.gisenv get=GRASS_MESSAGE_FORMAT]
+        set env(GRASS_MESSAGE_FORMAT) gui
+	set ret [catch {open $cmd r} fh]
+        set env(GRASS_MESSAGE_FORMAT) $message_env
+
+	set _data($path,$ci,fh) $fh
+
+	if { $ret } {
+		Gronsole::remove_tag $path $ci running
+		Gronsole::add_tag $path $ci error
+		catch {close $fh}
+		Gronsole::done_command $path $ci
+	} {
+		$execcmd $path $ci $mark $fh
+	}
+	update idletasks
+}
+
+##########################################################################
+# Public interface for running commands
+
+proc Gronsole::annotate {path cmd tags} {
+	variable _data
+
+	set ci [Gronsole::create_command $path $cmd]
+
+	foreach tag $tags {
+		Gronsole::add_tag $path $ci $tag
+	}
+
+	$path.text yview end
+	
+	return $ci
+}
+
+proc Gronsole::annotate_text {path ci text} {
+	Gronsole::output_to_gronsole $path cmdinsert$ci $ci [list cmd$ci cmd$ci-out] $text
+	$path.text see cmdinsert$ci
+}
+
+proc Gronsole::run {path cmd tags donecmd} {
+	variable _data
+	
+	set tags [concat running $tags]
+
+	set ci [Gronsole::annotate $path $cmd $tags]
+
+	set _data($path,$ci,donecmd) $donecmd
+
+	Gronsole::execout $path $cmd $ci Gronsole::execbg
+
+	return $ci
+}
+
+proc Gronsole::run_wait {path cmd tags} {
+	set tags [concat running $tags]
+
+	set ci [Gronsole::annotate $path $cmd $tags]
+
+	Gronsole::execout $path $cmd $ci Gronsole::execwait
+}
+
+proc Gronsole::run_xterm {path cmd tags} {
+	global env
+	global mingw
+
+	Gronsole::annotate $path $cmd [concat xterm $tags]
+
+	if { $mingw == "1" } {
+	    exec -- cmd.exe /c start $env(GISBASE)/etc/grass-run.bat $cmd &
+	} else {
+	    exec -- $env(GISBASE)/etc/grass-xterm-wrapper -name xterm-grass -e $env(GISBASE)/etc/grass-run.sh $cmd &
+	}
+
+	update idletasks
+}

lib/gtcltk/options.tcl

@@ -0,0 +1,115 @@
+############################################################################
+#
+# LIBRARY:      options.tcl gui options
+# AUTHOR(S):    Cedric Shock (cedricgrass AT shockfamily.net)
+# PURPOSE:      Default options and load user options
+# COPYRIGHT:    (C) 2006 GRASS Development Team
+#
+#               This program is free software under the GNU General Public
+#               License (>=v2). Read the file COPYING that comes with GRASS
+#               for details.
+#
+############################################################################
+
+lappend auto_path $env(GISBASE)/bwidget
+package require -exact BWidget 1.2.1
+
+# set background color and help font
+# These globals are still used in a few places by things in gis.m
+set bgcolor HoneyDew2
+
+##############################################################################
+# Create fonts
+
+proc fontcreate {font args} {
+	if {[lsearch [font names] $font] == -1} {
+		eval font create $font $args
+	} else {
+		eval font configure $font $args
+	}
+}
+
+fontcreate balloon-help -family Helvetica -size -12
+fontcreate default -family Helvetica -size -12
+fontcreate textfont -family Courier -size -12
+fontcreate bolddefault -family Helvetica -size 12 -weight bold
+fontcreate introfont -family Helvetica -size 14 -weight bold
+
+global bolddefault
+global introfont
+global textfont
+global default
+
+##############################################################################
+# Configure balloon help:
+
+DynamicHelp::configure -font balloon-help -fg black -bg "#FFFF77"
+
+##############################################################################
+# Configure almost everything using the options database
+
+# Font to use everywhere
+option add *font default
+# Font in labelframes of labels in bwidgets is prefixed with label:
+option add *labelfont default
+
+# Various background colors
+option add *background #dddddd
+option add *activeBackground #dddddd
+option add *highlightBackground #dddddd
+option add *ButtonBox.background HoneyDew2
+option add *ButtonBox*add.highlightBackground HoneyDew2
+option add *MainFrame.background HoneyDew2
+option add *PanedWindow.background HoneyDew2
+option add *Menu.background HoneyDew2
+option add *listbox.background white
+option add *addindicator.background white
+
+# Things that are selected:
+option add *selectBackground #ffff9b
+option add *selectForeground black
+
+# Menus use active instead of selected
+option add *Menu.activeBackground #ffff9b
+option add *Menu.activeForeground black
+
+# Scrollbar trough color
+option add *troughColor HoneyDew3
+
+# Entry widgets and text widgets should have a white background
+option add *Entry.background white
+option add *entry.background white
+option add *Entry.highlightbackground #dddddd
+option add *entrybg white
+option add *Text.background white
+option add *Entry.font textfont
+option add *Text.font textfont
+
+# Options for map canvases
+option add *mapcanvas.background #eeeeee
+option add *mapcanvas.insertbackground black
+option add *mapcanvas.selectbackground #c4c4c4
+option add *mapcanvas.selectforeground black
+
+
+##############################################################################
+# Platform specific default settings:
+# keycontrol is control key used in copy-paste bindings
+
+set keycontrol "Control"
+
+if {[info exists env(osxaqua)]} {
+    set osxaqua $env(osxaqua)
+} else {
+    set osxaqua "0"
+}
+
+if { $osxaqua == "1"} {
+    set keycontrol "Command"
+}
+
+if {[info exists env(OS)] && $env(OS) == "Windows_NT"} {
+    set mingw "1"
+} else {
+    set mingw "0"
+}

lib/gtcltk/select.tcl

@@ -0,0 +1,316 @@
+##########################################################################
+#
+# select.tcl
+#
+# tree/listbox control for interactive selection of GRASS GIS elements
+#
+# Author: Unknown. Possibly Jacques Bouchard, author of tcltkgrass for
+#   GRASS 5. Subsequent modifications by members of the GRASS Development
+#   team.
+#
+# Last update: September 2007
+#
+# COPYRIGHT:	(C) 1999 - 2007 by the GRASS Development Team
+#
+#		This program is free software under the GNU General Public
+#		License (>=v2). Read the file COPYING that comes with GRASS
+#		for details.
+#
+##########################################################################
+# Frame scrolling that works:
+# Scroll if the window exists AND
+# the window is mapped AND
+# This window's parent's descendant has the focus (keyboard or mouse pointer in)
+# We use the parent because the scrollbars are in the parent, and two scrollable
+# Things shouldn't have the same parent.
+
+set bind_scroll_list {}
+
+proc handle_scroll {ammount} {
+    global bind_scroll_list
+
+    foreach {x y} {-1 -1} {}
+
+    set window_gone 0
+
+    foreach window $bind_scroll_list {
+        if {![winfo exists $window]} {
+            set window_gone 1
+            continue
+        } 
+        if {![winfo ismapped $window]} continue
+        set parent [winfo parent $window]
+        set keyboard_focus [focus -displayof $window]
+        foreach {x y} [winfo pointerxy $window] {break}
+        set mouse_focus [winfo containing -displayof $window $x $y]
+		set l [string length $parent]
+        if {[string equal -length $l $parent $keyboard_focus] || \
+            [string equal -length $l $parent $mouse_focus]} {
+            $window yview scroll [expr {-$ammount/120}] units
+        }
+    }
+
+    # We should thin out windows that don't exist anymore if we find them
+    if {$window_gone} {
+        set new_bind_scroll_list {}
+        foreach window $bind_scroll_list {
+            if {[winfo exists $window]} {
+                lappend new_bind_scroll_list $window
+            }
+        }
+        set bind_scroll_list $new_bind_scroll_list
+    }
+}
+
+proc bind_scroll {frame} {
+    global bind_scroll_list
+
+    lappend bind_scroll_list $frame
+}
+
+bind all <MouseWheel> "handle_scroll %D"
+bind all <Button-4> "handle_scroll 120"
+bind all <Button-5> "handle_scroll -120"
+
+##############################################################
+
+proc GSelect { element args } {
+    # startup procedure 
+
+    set sel [eval [linsert $args 0 GSelect_::create $element]]
+    return $sel
+
+}
+
+namespace eval GSelect_ {
+    variable count 1
+    variable dblclick
+    variable array selwin
+}
+
+proc GSelect_::create { element args } {
+    # main procedure for creating and managing selection window, which a tree
+    # within a scrolling window.
+
+    global env id
+    variable selwin
+    variable count
+    
+    incr count
+    set id $count
+    
+    set selwin($id,self) selwin
+    set title [G_msg "Select item"]
+    set selwin($id,selected) {}
+    
+    if {[lsearch -exact $args "title"] > -1} {
+	append title " - [lindex $args [expr [lsearch -exact $args title]+1]]"
+    }
+    
+    # Leave selection on top of caller window till it's closed
+    set parentwin "."
+    if {[lsearch -exact $args "parent"] > -1} {
+    	set parentwin [lindex $args [expr [lsearch -exact $args "parent"]+1]]
+    	if { [string length $parentwin] > 1 } {
+    		set selwin($id,self) [regsub -all {[[:space:]]|[[:punct:]]} ".selwin[string range $parentwin 1 [string length $parentwin]]" ""]
+    	} elseif {[lsearch -exact $args "title"] > -1} { set selwin($id,self) [regsub -all {[[:space:]]|[[:punct:]]} ".selwin$title" ""] }
+    } 
+    set selwin($id,self) ".$selwin($id,self)"
+    set selftop "$selwin($id,self)top"
+
+    # Do not create another select window, if one already exists.
+    if {[winfo exists $selwin($id,self)]} {
+    	raise $selwin($id,self) 
+    	focus $selwin($id,self) 
+    	return
+    }
+
+    toplevel $selwin($id,self) -width 300 -height 400 
+    set sw    [ScrolledWindow $selwin($id,self).sw -relief sunken -borderwidth 2 ]
+    
+    wm title $selwin($id,self) $title
+    wm transient $selwin($id,self) $parentwin
+
+    set tree  [Tree $sw.tree \
+                   -relief flat -borderwidth 0 -width 15 -highlightthickness 0\
+		   -redraw 1 -dropenabled 1 -dragenabled 1 \
+                   -opencmd   "GSelect_::moddir 1 $sw.tree" \
+                   -closecmd  "GSelect_::moddir 0 $sw.tree"] 
+
+    $sw setwidget $tree
+    bind_scroll $tree
+
+    regexp -- {(.+)x(.+)([+-].+)([+-].+)} [wm geometry .] g w h x y
+    #set w [expr int(2*$w/3)]
+    set w 300
+    set h 400
+    wm geometry $selwin($id,self) ${w}x$h$x$y
+
+    pack $sw    -side top  -expand yes -fill both
+    pack $tree  -side top -expand yes -fill both 
+
+    $tree bindText  <ButtonPress-1>        "GSelect_::select $id $tree"
+    $tree bindImage <ButtonPress-1>        "GSelect_::select $id $tree"
+    $tree bindText  <Double-ButtonPress-1> "GSelect_::selectclose $id $tree"
+    $tree bindImage <Double-ButtonPress-1> "GSelect_::selectclose $id $tree"
+    if {[lsearch $args "multiple"] >= 0} {
+    	$tree bindText  <Control-ButtonPress-1> "GSelect_::select_toggle $id $tree"
+    } else {
+    	$tree bindText  <Control-ButtonPress-1> "GSelect_::select $id $tree"
+    }
+    
+    set location_path "$env(GISDBASE)/$env(LOCATION_NAME)/"
+    set current_mapset "$env(MAPSET)"
+    set sympath "$env(GISBASE)/etc/symbol/"
+    
+    # main selection subroutine
+    if {$element != "symbol"} {
+        foreach dir [exec g.mapsets -p] {
+            set windfile "$location_path/$dir/WIND"
+            if { ! [ file exists $windfile ] } { continue }
+            if { $dir == $current_mapset } {
+                $tree insert end root ms_$dir -text $dir -data $dir -open 1 \
+                -image [Bitmap::get openfold] -drawcross auto
+            } else {
+                $tree insert end root ms_$dir -text $dir -data $dir -open 0 \
+                -image [Bitmap::get folder] -drawcross auto
+            }
+            set path "$location_path/$dir/$element/"
+            foreach fp [ lsort [glob -nocomplain $path/*] ]  {
+            set file [file tail $fp]
+            $tree insert end ms_$dir $file@$dir -text $file -data $file \
+                -image [Bitmap::get file] -drawcross never
+            }
+        }
+    }
+
+    # vector symbol selection subroutine
+    if {$element == "symbol"} {
+        $tree insert end root ms_$sympath -text SYMBOLS -data $sympath -open 1 \
+            -image [Bitmap::get openfold] -drawcross auto
+        
+        foreach ic_dir [ lsort [glob -nocomplain $sympath/*] ]  {
+            set dir_tail [file tail $ic_dir]
+            $tree insert end ms_$sympath ms_$dir_tail  -text $dir_tail -data $dir_tail \
+                -image [Bitmap::get folder] -drawcross auto
+    
+            foreach ic_file [ lsort [glob -nocomplain $sympath/$dir_tail/*] ]  {
+                set file [file tail $ic_file]
+                $tree insert end ms_$dir_tail $dir_tail/$file -text $file -data $file \
+                    -image [Bitmap::get file] -drawcross never
+            }
+        }
+    }
+
+    $tree configure -redraw 1
+
+    # buttons
+    button $selwin($id,self).ok -text [G_msg "Ok"] -command "destroy $selwin($id,self)"
+    button $selwin($id,self).cancel -text [G_msg "Cancel"] -command "GSelect_::terminate $id"
+
+    pack $selwin($id,self).ok $selwin($id,self).cancel -side left -expand yes
+
+
+    # ScrollView
+    toplevel $selftop -relief raised -borderwidth 2
+    wm protocol $selftop WM_DELETE_WINDOW {
+        # don't kill me
+    }
+    wm overrideredirect $selftop 1
+    wm withdraw $selftop
+    wm transient $selftop $selwin($id,self)
+    ScrollView $selftop.sv -window $tree -fill black
+    pack $selftop.sv -fill both -expand yes
+
+    wm protocol $selwin($id,self) WM_DELETE_WINDOW "GSelect_::terminate $id"
+    tkwait window $selwin($id,self)
+
+    destroy $selftop 
+
+    # return selected elements -- separated by commas if there are > 1 elements
+    if { $selwin($id,selected) != "" } {
+        set ret ""
+        set len [llength $selwin($id,selected)]
+        foreach elem $selwin($id,selected) {
+            append ret $elem
+            if {[lsearch $selwin($id,selected) $elem] != -1  && \
+                [lsearch $selwin($id,selected) $elem] < [expr $len-1]} {
+                append ret ","
+            }
+        }
+        return $ret
+    }
+
+    return ""
+}
+
+
+proc GSelect_::select { id tree node } {
+    # Single selection (default). Clicking an item will select it and 
+    # deselect any other item selected
+    variable selwin
+ 
+    set parent [$tree parent $node]
+    if { $parent == "root" } { return }
+ 
+    $tree selection set $node
+    update
+    set selwin($id,selected) $node
+}
+
+proc GSelect_::select_toggle { id tree node} {
+    # Multiple selections. Ctrl-1 will toggle an item as selected or not selected
+    # and add it to a list of selected items
+    variable selwin
+ 
+    set parent [$tree parent $node]
+    if { $parent == "root" } { return }
+ 
+    if {[lsearch -exact [$tree selection get] $node] >= 0} {
+        $tree selection remove $node
+        update
+        set nodeindex [lsearch $selwin($id,selected) $node]
+        if {$nodeindex != -1} {
+            set selwin($id,selected) [lreplace $selwin($id,selected) $nodeindex $nodeindex]
+        }
+    } else {
+        $tree selection add $node
+        update
+        lappend selwin($id,selected) $node
+    }
+     
+    #$tree selection add $node
+#     set selwin($id,selected) [string trim $selwin($id,selected) ,]
+}
+
+proc GSelect_::selectclose { id tree node } {
+    # return selection and close window (OK button)
+    variable selwin
+
+    GSelect_::select $id $tree $node
+    destroy $selwin($id,self)
+}
+
+
+proc GSelect_::terminate { id } {
+    # close window without returning selection (cancel)
+	variable selwin
+	
+	set selwin($id,selected) {}
+	destroy $selwin($id,self)
+}
+
+proc GSelect_::moddir { idx tree node } {
+    if { $idx && [$tree itemcget $node -drawcross] == "always" } {
+        getdir $tree $node [$tree itemcget $node -data]
+        if { [llength [$tree nodes $node]] } {
+            $tree itemconfigure $node -image [Bitmap::get openfold]
+        } else {
+            $tree itemconfigure $node -image [Bitmap::get folder]
+        }
+    } else {
+        $tree itemconfigure $node -image [Bitmap::get [lindex {folder openfold} $idx]]
+    }
+}
+
+