Explorar el Código

remove bwidget library (no TCL/TK dependency in G7)

git-svn-id: https://svn.osgeo.org/grass/grass/trunk@53751 15284696-431f-4ddb-bdfa-cd5b030d7da7
Martin Landa hace 12 años
padre
commit
0a1d85dbec
Se han modificado 76 ficheros con 0 adiciones y 13615 borrados
  1. 0 1
      lib/external/Makefile
  2. 0 266
      lib/external/bwidget/CHANGES.txt
  3. 0 504
      lib/external/bwidget/LGPL-2.1.txt
  4. 0 16
      lib/external/bwidget/LICENSE.txt
  5. 0 19
      lib/external/bwidget/Makefile
  6. 0 148
      lib/external/bwidget/README
  7. 0 38
      lib/external/bwidget/README.grass
  8. 0 548
      lib/external/bwidget/arrow.tcl
  9. 0 92
      lib/external/bwidget/bitmap.tcl
  10. 0 302
      lib/external/bwidget/button.tcl
  11. 0 226
      lib/external/bwidget/buttonbox.tcl
  12. 0 314
      lib/external/bwidget/color.tcl
  13. 0 340
      lib/external/bwidget/combobox.tcl
  14. 0 290
      lib/external/bwidget/dialog.tcl
  15. 0 190
      lib/external/bwidget/dragsite.tcl
  16. 0 451
      lib/external/bwidget/dropsite.tcl
  17. 0 332
      lib/external/bwidget/dynhelp.tcl
  18. 0 426
      lib/external/bwidget/entry.tcl
  19. 0 379
      lib/external/bwidget/font.tcl
  20. BIN
      lib/external/bwidget/images/bold.gif
  21. BIN
      lib/external/bwidget/images/copy.gif
  22. BIN
      lib/external/bwidget/images/cut.gif
  23. BIN
      lib/external/bwidget/images/dragfile.gif
  24. BIN
      lib/external/bwidget/images/dragicon.gif
  25. BIN
      lib/external/bwidget/images/error.gif
  26. BIN
      lib/external/bwidget/images/file.gif
  27. BIN
      lib/external/bwidget/images/folder.gif
  28. BIN
      lib/external/bwidget/images/hourglass.gif
  29. BIN
      lib/external/bwidget/images/info.gif
  30. BIN
      lib/external/bwidget/images/italic.gif
  31. 0 5
      lib/external/bwidget/images/minus.xbm
  32. BIN
      lib/external/bwidget/images/new.gif
  33. 0 5
      lib/external/bwidget/images/opcopy.xbm
  34. BIN
      lib/external/bwidget/images/open.gif
  35. BIN
      lib/external/bwidget/images/openfold.gif
  36. 0 5
      lib/external/bwidget/images/oplink.xbm
  37. 0 5
      lib/external/bwidget/images/opmove.xbm
  38. BIN
      lib/external/bwidget/images/overstrike.gif
  39. BIN
      lib/external/bwidget/images/palette.gif
  40. BIN
      lib/external/bwidget/images/passwd.gif
  41. BIN
      lib/external/bwidget/images/paste.gif
  42. 0 5
      lib/external/bwidget/images/plus.xbm
  43. BIN
      lib/external/bwidget/images/print.gif
  44. BIN
      lib/external/bwidget/images/question.gif
  45. BIN
      lib/external/bwidget/images/save.gif
  46. BIN
      lib/external/bwidget/images/underline.gif
  47. BIN
      lib/external/bwidget/images/undo.gif
  48. BIN
      lib/external/bwidget/images/warning.gif
  49. 0 21
      lib/external/bwidget/init.tcl
  50. 0 258
      lib/external/bwidget/label.tcl
  51. 0 100
      lib/external/bwidget/labelentry.tcl
  52. 0 160
      lib/external/bwidget/labelframe.tcl
  53. 0 52
      lib/external/bwidget/lang/de.rc
  54. 0 52
      lib/external/bwidget/lang/en.rc
  55. 0 53
      lib/external/bwidget/lang/es.rc
  56. 0 52
      lib/external/bwidget/lang/fr.rc
  57. 0 1179
      lib/external/bwidget/listbox.tcl
  58. 0 517
      lib/external/bwidget/mainframe.tcl
  59. 0 111
      lib/external/bwidget/messagedlg.tcl
  60. 0 866
      lib/external/bwidget/notebook.tcl
  61. 0 298
      lib/external/bwidget/pagesmgr.tcl
  62. 0 303
      lib/external/bwidget/panedw.tcl
  63. 0 176
      lib/external/bwidget/passwddlg.tcl
  64. 0 43
      lib/external/bwidget/pkgIndex.tcl
  65. 0 186
      lib/external/bwidget/progressbar.tcl
  66. 0 89
      lib/external/bwidget/progressdlg.tcl
  67. 0 210
      lib/external/bwidget/scrollframe.tcl
  68. 0 257
      lib/external/bwidget/scrollview.tcl
  69. 0 254
      lib/external/bwidget/scrollw.tcl
  70. 0 82
      lib/external/bwidget/separator.tcl
  71. 0 353
      lib/external/bwidget/spinbox.tcl
  72. 0 152
      lib/external/bwidget/titleframe.tcl
  73. 0 1389
      lib/external/bwidget/tree.tcl
  74. 0 408
      lib/external/bwidget/utils.tcl
  75. 0 972
      lib/external/bwidget/widget.tcl
  76. 0 115
      lib/external/bwidget/xpm2image.tcl

+ 0 - 1
lib/external/Makefile

@@ -2,7 +2,6 @@
 MODULE_TOPDIR = ../..
 MODULE_TOPDIR = ../..
 
 
 SUBDIRS = \
 SUBDIRS = \
-	bwidget \
 	ccmath  \
 	ccmath  \
 	shapelib
 	shapelib
 
 

+ 0 - 266
lib/external/bwidget/CHANGES.txt

@@ -1,266 +0,0 @@
-____________________________________________________________
-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.
-

+ 0 - 504
lib/external/bwidget/LGPL-2.1.txt

@@ -1,504 +0,0 @@
-		  GNU LESSER GENERAL PUBLIC LICENSE
-		       Version 2.1, February 1999
-
- Copyright (C) 1991, 1999 Free Software Foundation, Inc.
- 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  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 Lesser GPL.  It also counts
- as the successor of the GNU Library Public License, version 2, hence
- the version number 2.1.]
-
-			    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 Lesser General Public License, applies to some
-specially designated software packages--typically libraries--of the
-Free Software Foundation and other authors who decide to use it.  You
-can use it too, but we suggest you first think carefully about whether
-this license or the ordinary General Public License is the better
-strategy to use in any particular case, based on the explanations below.
-
-  When we speak of free software, we are referring to freedom of use,
-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 and use pieces of
-it in new free programs; and that you are informed that you can do
-these things.
-
-  To protect your rights, we need to make restrictions that forbid
-distributors to deny you these rights or to ask you to surrender these
-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 other code 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.
-
-  We protect your rights with a two-step method: (1) we copyright the
-library, and (2) we offer you this license, which gives you legal
-permission to copy, distribute and/or modify the library.
-
-  To protect each distributor, we want to make it very clear that
-there is no warranty for the free library.  Also, if the library is
-modified by someone else and passed on, the recipients should know
-that what they have is not the original version, so that the original
-author's reputation will not be affected by problems that might be
-introduced by others.
-
-  Finally, software patents pose a constant threat to the existence of
-any free program.  We wish to make sure that a company cannot
-effectively restrict the users of a free program by obtaining a
-restrictive license from a patent holder.  Therefore, we insist that
-any patent license obtained for a version of the library must be
-consistent with the full freedom of use specified in this license.
-
-  Most GNU software, including some libraries, is covered by the
-ordinary GNU General Public License.  This license, the GNU Lesser
-General Public License, applies to certain designated libraries, and
-is quite different from the ordinary General Public License.  We use
-this license for certain libraries in order to permit linking those
-libraries into non-free programs.
-
-  When a program is linked with a library, whether statically or using
-a shared library, the combination of the two is legally speaking a
-combined work, a derivative of the original library.  The ordinary
-General Public License therefore permits such linking only if the
-entire combination fits its criteria of freedom.  The Lesser General
-Public License permits more lax criteria for linking other code with
-the library.
-
-  We call this license the "Lesser" General Public License because it
-does Less to protect the user's freedom than the ordinary General
-Public License.  It also provides other free software developers Less
-of an advantage over competing non-free programs.  These disadvantages
-are the reason we use the ordinary General Public License for many
-libraries.  However, the Lesser license provides advantages in certain
-special circumstances.
-
-  For example, on rare occasions, there may be a special need to
-encourage the widest possible use of a certain library, so that it becomes
-a de-facto standard.  To achieve this, non-free programs must be
-allowed to use the library.  A more frequent case is that a free
-library does the same job as widely used non-free libraries.  In this
-case, there is little to gain by limiting the free library to free
-software only, so we use the Lesser General Public License.
-
-  In other cases, permission to use a particular library in non-free
-programs enables a greater number of people to use a large body of
-free software.  For example, permission to use the GNU C Library in
-non-free programs enables many more people to use the whole GNU
-operating system, as well as its variant, the GNU/Linux operating
-system.
-
-  Although the Lesser General Public License is Less protective of the
-users' freedom, it does ensure that the user of a program that is
-linked with the Library has the freedom and the wherewithal to run
-that program using a modified version of the Library.
-
-  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, whereas the latter must
-be combined with the library in order to run.
-
-		  GNU LESSER GENERAL PUBLIC LICENSE
-   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
-
-  0. This License Agreement applies to any software library or other
-program which contains a notice placed by the copyright holder or
-other authorized party saying it may be distributed under the terms of
-this Lesser 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 combine 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) Use a suitable shared library mechanism for linking with the
-    Library.  A suitable mechanism is one that (1) uses at run time a
-    copy of the library already present on the user's computer system,
-    rather than copying library functions into the executable, and (2)
-    will operate properly with a modified version of the library, if
-    the user installs one, as long as the modified version is
-    interface-compatible with the version that the work was made with.
-
-    c) 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.
-
-    d) 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.
-
-    e) 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 materials to be 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 with
-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 Lesser 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 Lesser General Public
-    License as published by the Free Software Foundation; either
-    version 2.1 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
-    Lesser General Public License for more details.
-
-    You should have received a copy of the GNU Lesser General Public
-    License along with this library; if not, write to the Free Software
-    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  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!
-
-

+ 0 - 16
lib/external/bwidget/LICENSE.txt

@@ -1,16 +0,0 @@
-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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA

+ 0 - 19
lib/external/bwidget/Makefile

@@ -1,19 +0,0 @@
-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))
-
-ifneq ($(strip $(TCLTKLIBS)),)
-default:
-	$(MAKE) $(DSTFILES)
-endif
-
-$(BWIDGETDIR)/%: % | $(BWIDGETDIR) $(BWIDGETDIR)/images $(BWIDGETDIR)/lang
-	$(INSTALL_DATA) $< $@
-
-$(BWIDGETDIR) $(BWIDGETDIR)/images $(BWIDGETDIR)/lang: %:
-	$(MKDIR) $@

+ 0 - 148
lib/external/bwidget/README

@@ -1,148 +0,0 @@
-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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 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
-
-
-

+ 0 - 38
lib/external/bwidget/README.grass

@@ -1,38 +0,0 @@
-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.

+ 0 - 548
lib/external/bwidget/arrow.tcl

@@ -1,548 +0,0 @@
-# ------------------------------------------------------------------------------
-#  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"
-    }
-}
-

+ 0 - 92
lib/external/bwidget/bitmap.tcl

@@ -1,92 +0,0 @@
-# ------------------------------------------------------------------------------
-#  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

+ 0 - 302
lib/external/bwidget/button.tcl

@@ -1,302 +0,0 @@
-# ------------------------------------------------------------------------------
-#  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"
-    }
-}
-

+ 0 - 226
lib/external/bwidget/buttonbox.tcl

@@ -1,226 +0,0 @@
-# ------------------------------------------------------------------------------
-#  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 {}
-}

+ 0 - 314
lib/external/bwidget/color.tcl

@@ -1,314 +0,0 @@
-# ------------------------------------------------------------------------------
-#  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]
-}

+ 0 - 340
lib/external/bwidget/combobox.tcl

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

+ 0 - 290
lib/external/bwidget/dialog.tcl

@@ -1,290 +0,0 @@
-# ------------------------------------------------------------------------------
-#  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 {}
-}

+ 0 - 190
lib/external/bwidget/dragsite.tcl

@@ -1,190 +0,0 @@
-# ------------------------------------------------------------------------------
-#  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]
-    }
-}
-
-

+ 0 - 451
lib/external/bwidget/dropsite.tcl

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

+ 0 - 332
lib/external/bwidget/dynhelp.tcl

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

+ 0 - 426
lib/external/bwidget/entry.tcl

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

+ 0 - 379
lib/external/bwidget/font.tcl

@@ -1,379 +0,0 @@
-# ------------------------------------------------------------------------------
-#  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"}]
-        }
-    }
-}
-

BIN
lib/external/bwidget/images/bold.gif


BIN
lib/external/bwidget/images/copy.gif


BIN
lib/external/bwidget/images/cut.gif


BIN
lib/external/bwidget/images/dragfile.gif


BIN
lib/external/bwidget/images/dragicon.gif


BIN
lib/external/bwidget/images/error.gif


BIN
lib/external/bwidget/images/file.gif


BIN
lib/external/bwidget/images/folder.gif


BIN
lib/external/bwidget/images/hourglass.gif


BIN
lib/external/bwidget/images/info.gif


BIN
lib/external/bwidget/images/italic.gif


+ 0 - 5
lib/external/bwidget/images/minus.xbm

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

BIN
lib/external/bwidget/images/new.gif


+ 0 - 5
lib/external/bwidget/images/opcopy.xbm

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

BIN
lib/external/bwidget/images/open.gif


BIN
lib/external/bwidget/images/openfold.gif


+ 0 - 5
lib/external/bwidget/images/oplink.xbm

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

+ 0 - 5
lib/external/bwidget/images/opmove.xbm

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

BIN
lib/external/bwidget/images/overstrike.gif


BIN
lib/external/bwidget/images/palette.gif


BIN
lib/external/bwidget/images/passwd.gif


BIN
lib/external/bwidget/images/paste.gif


+ 0 - 5
lib/external/bwidget/images/plus.xbm

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

BIN
lib/external/bwidget/images/print.gif


BIN
lib/external/bwidget/images/question.gif


BIN
lib/external/bwidget/images/save.gif


BIN
lib/external/bwidget/images/underline.gif


BIN
lib/external/bwidget/images/undo.gif


BIN
lib/external/bwidget/images/warning.gif


+ 0 - 21
lib/external/bwidget/init.tcl

@@ -1,21 +0,0 @@
-
-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]}

+ 0 - 258
lib/external/bwidget/label.tcl

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

+ 0 - 100
lib/external/bwidget/labelentry.tcl

@@ -1,100 +0,0 @@
-# ------------------------------------------------------------------------------
-#  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]
-    }
-}

+ 0 - 160
lib/external/bwidget/labelframe.tcl

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

+ 0 - 52
lib/external/bwidget/lang/de.rc

@@ -1,52 +0,0 @@
-! ------------------------------------------------------------------------------
-!  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

+ 0 - 52
lib/external/bwidget/lang/en.rc

@@ -1,52 +0,0 @@
-! ------------------------------------------------------------------------------
-!  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

+ 0 - 53
lib/external/bwidget/lang/es.rc

@@ -1,53 +0,0 @@
-! ------------------------------------------------------------------------------
-!  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
-

+ 0 - 52
lib/external/bwidget/lang/fr.rc

@@ -1,52 +0,0 @@
-! ------------------------------------------------------------------------------
-!  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

La diferencia del archivo ha sido suprimido porque es demasiado grande
+ 0 - 1179
lib/external/bwidget/listbox.tcl


+ 0 - 517
lib/external/bwidget/mainframe.tcl

@@ -1,517 +0,0 @@
-# ------------------------------------------------------------------------------
-#  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 {}
-}
-
-

+ 0 - 111
lib/external/bwidget/messagedlg.tcl

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

+ 0 - 866
lib/external/bwidget/notebook.tcl

@@ -1,866 +0,0 @@
-# ------------------------------------------------------------------------------
-#  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"
-}

+ 0 - 298
lib/external/bwidget/pagesmgr.tcl

@@ -1,298 +0,0 @@
-# ------------------------------------------------------------------------------
-#  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"
-}

+ 0 - 303
lib/external/bwidget/panedw.tcl

@@ -1,303 +0,0 @@
-# ------------------------------------------------------------------------------
-#  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> {}
-}

+ 0 - 176
lib/external/bwidget/passwddlg.tcl

@@ -1,176 +0,0 @@
-# -----------------------------------------------------------------------------
-#  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)] 
-}

+ 0 - 43
lib/external/bwidget/pkgIndex.tcl

@@ -1,43 +0,0 @@
-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]]; \
-"

+ 0 - 186
lib/external/bwidget/progressbar.tcl

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

+ 0 - 89
lib/external/bwidget/progressdlg.tcl

@@ -1,89 +0,0 @@
-# ------------------------------------------------------------------------------
-#  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]
-}

+ 0 - 210
lib/external/bwidget/scrollframe.tcl

@@ -1,210 +0,0 @@
-# ------------------------------------------------------------------------------
-#  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]
-    }
-}
-
-

+ 0 - 257
lib/external/bwidget/scrollview.tcl

@@ -1,257 +0,0 @@
-# ------------------------------------------------------------------------------
-#  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]
-    }
-}

+ 0 - 254
lib/external/bwidget/scrollw.tcl

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

+ 0 - 82
lib/external/bwidget/separator.tcl

@@ -1,82 +0,0 @@
-# ------------------------------------------------------------------------------
-#  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]
-}

+ 0 - 353
lib/external/bwidget/spinbox.tcl

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

+ 0 - 152
lib/external/bwidget/titleframe.tcl

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

La diferencia del archivo ha sido suprimido porque es demasiado grande
+ 0 - 1389
lib/external/bwidget/tree.tcl


+ 0 - 408
lib/external/bwidget/utils.tcl

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

+ 0 - 972
lib/external/bwidget/widget.tcl

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

+ 0 - 115
lib/external/bwidget/xpm2image.tcl

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