Itcl only itk

Check-in [6097bee1f3]

Many hyperlinks are disabled.

Overview
Comment: Initial setup of itk4 Tarball | ZIP archive | SQL archive family | ancestors | trunk files | file ages | folders 6097bee1f3b8e6ce5e40a2b32955422fa18441f0 rene 2012-05-24 08:31:48
Context
 2012-05-24 08:31 Initial setup of itk4 Leaf check-in: 6097bee1f3 user: rene tags: trunk 2012-05-23 08:17 initial empty check-in check-in: 0abcf6c130 user: rene tags: trunk
Changes

     > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > >  1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56  itk 4.0b1 -- itcl only itk ========================== Implementation of itk on top of itcl4 for tcl8.6 and beyond. Sources ------- The itk repository is hosted at: http://chiselapp.com/user/rene/repository/itk/ A slightly modified iwidgets (see iwidgets.patch) is hosted at: http://chiselapp.com/user/rene/repository/iwidgets/ Ready to run binaries (*-itk) can be found at: https://sourceforge.net/projects/kbskit/files/itk/ To load itk call: package require itk 4.0 and to load itk and iwidgets call: package require iwidgets 4.1 Install ------- Copy the library directory as itk4.0b1 in your tcl library path. cp -r library /itk4.0b1 Documentation ------------- To generate documentation you need the 'doxygen' program from doxygen.org. Change into the "doc/" subdirectory. To create html documentation in subdirectory "doc/html/" run: doxygen To create pdf documentation in file "doc/latex/refman.pdf" run: doxygen Doxyfile.pdf cd latex make To create man pages documentation in subdirectory "doc/man/" run: doxygen Doxyfile.man License & support ----------------- This work is under BSD license (see file 'license.terms') Acknowledgements ---------------- This work is based on the original "incrTk" work at http://sf.net/projects/incrtcl/ and "incrTcl" 4 (starting at itcl-4-0-b8-rc) by Arnulf Wiedemann at http://core.tcl.tk/itcl/ 

     > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > >  1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349  /*! \page Archetype Archetype \par NAME Archetype - base class for all [itk] mega-widgets \par WIDGET-SPECIFIC OPTIONS \option{-clientdata,clientData,ClientData} \par This does not affect the widget operation in any way. It is simply a hook that clients can use to store a bit of data with each widget. This can come in handy when using widgets to build applications. \par DESCRIPTION The \b Archetype class is the basis of all [itk] mega-widgets. It keeps track of component widgets and provides methods like "configure" and "cget" that are used to access the composite configuration options. Each component widget must be registered with the \b Archetype base class using the "itk_component add" method. When the component is registered, its configuration options are integrated into the composite option list. Configuring a composite option like "-background" causes all of the internal components to change their background color. It is not used as a widget by itself, but is used as a base class for more specialized widgets. The Widget base class inherits from \b Archetype, and adds a Tk frame which acts as the "hull" for the mega-widget. The Toplevel base class inherits from \b Archetype, but adds a Tk toplevel which acts as the "hull". Each derived class must invoke the \b itk_initialize method within its constructor, so that all options are properly integrated and initialized in the composite list. \par PUBLIC METHODS The following methods are provided to support the public interface of the mega-widget. \a pathName \b cget \a option \par Returns the current value of the configuration option given by option. \par In this case, option refers to a composite configuration option for the mega-widget. Individual components integrate their own configuration options onto the composite list when they are registered by the "itk_component add" method. \a pathName \b component ?name? ?command arg arg ...? \par Used to query or access component widgets within a mega-widget. \par With no arguments, this returns a list of symbolic names for component widgets that are accessible in the current scope. The symbolic name for a component is established when it is registered by the "itk_component add" method. Note that component widgets obey any public/protected/private access restriction that is in force when the component is created. \par If a symbolic name is specified, this method returns the window path name for that component. \par Otherwise, the command and any remaining arg arguments are invoked as a method on the component with the symbolic name name. This provides a well-defined way of accessing internal components without relying on specific window path names, which are really details of the implementation. \a pathName \b configure ?option? ?value option value ...? \par Query or modify the configuration options of the widget. \par If no option is specified, returns a list describing all of the available options for pathName (see Tk_ConfigureInfo for information on the format of this list). \par If option is specified with no value, then the command returns a list describing the one named option (this list will be identical to the corresponding sublist of the value returned if no option is specified). \par If one or more option-value pairs are specified, then the command modifies the given widget option(s) to have the given value(s); in this case the command returns an empty string. \par In this case, the options refer to composite configuration options for the mega-widget. Individual components integrate their own configuration options onto the composite list when they are registered by the "itk_component add" method. \par PROTECTED METHODS The following methods are used in derived classes as part of the implementation for a mega-widget. itk_component add ?-protected? ?-private? ?--? name createCmds ?optionCmds? \par Creates a component widget by executing the createCmds argument and registers the new component with the symbolic name name. \par The \b -protected and \b -private options can be used to keep the component hidden from the outside world. These options have a similar effect on component visibility as they have on class members. \par The \a createCmds code can contain any number of commands, but it must return the window path name for the new component widget. \par The \a optionCmds script contains commands that describe how the configuration options for the new component should be integrated into the composite list for the mega-widget. It can contain any of the following commands: \par \b ignore option ?option option ...? \n Removes one or more configuration options from the composite list. All options are ignored by default, so the ignore command is only used to negate the effect of a previous keep or rename command. This is useful, for example, when the some of the options added by the usual command should not apply to a particular component, and need to be ignored. \par \b keep option ?option option ...? \n Integrates one or more configuration options into the composite list, keeping the name the same. Whenever the mega-widget option is configured, the new value is also applied to the current component. Options like "-background" and "-cursor" are commonly found on the keep list. \par \b rename option switchName resourceName resourceClass \n Integrates the configuration option into the composite list with a different name. The option will be called switchName on the composite list. It will also be modified by setting values for resourceName and resourceClass in the X11 resource database. The "-highlightbackground" option is commonly renamed to "-background", so that when the mega-widget background changes, the background of the focus ring will change as well. \par \b usual \a ?tag? \n Finds the usual option-handling commands for the specified tag name and executes them. If the tag is not specified, then the widget class name is used as the tag name. The "usual" option-handling commands are registered via the usual command. If the optionCmds script is not specified, the usual option-handling commands associated with the class of the component widget are used by default. \b itk_component \b delete name ?name name ...? \par Removes the component widget with the symbolic name name from the mega-widget.# The component widget will still exist, but it will no longer be accessible as a component of the mega-widget. Also, any options associated with the component are removed from the composite option list. \par Note that you can destroy a component using the destroy command, just as you would destroy any Tk widget. Components automatically detach themselves from their mega-widget parent when destroyed, so "itk_component delete" is rarely used. \b itk_initialize ?option value option value...? \par This method must be invoked within the constructor for each class in a mega-widget hierarchy. \par It makes sure that all options are properly integrated into the composite option list, and synchronizes all components to the initial option values. It is usually invoked near the bottom of the constructor, after all component widgets have been added. \par If any option/value pairs are specified, they override settings determined from the X11 resource database. The arguments to the constructor are usually passed along to this method as follows: \verbatim itcl::class MyWidget { inherit Widget constructor {args} { . . . eval itk_initialize $args } } \endverbatim \b itk_option \b add optName ?optName optName ...? \par Adds one or more options to the composite option list for a mega-widget. Here, optName can have one of the following forms: \par \b component.option \n Accesses an option belonging to a component with the symbolic name component. The option name is specified without a leading "-" sign. \par \b className::option \n Accesses an option defined by the "itk_option define" command in class className. The option name is specified without a leading "-" sign. \par Options are normally integrated into the composite option list when a component widget is first created. This method can be used to add options at a later time. For example, the Widget and Toplevel base classes keep only the bare minimum options for their "hull" component: -background and -cursor. A derived class can override this decision, and add options that control the border of the "hull" component as well: \verbatim itcl::class MyWidget { inherit Widget constructor {args} { itk_option add hull.borderwidth hull.relief itk_component add label { label$itk_interior.l1 -text "Hello World!" } pack $itk_component(label) eval itk_initialize$args } } \endverbatim \b itk_option \b define switchName resourceName resourceClass init ?config? \par This command is used at the level of the class definition to define a synthetic mega-widget option. Within the configure and cget methods, this option is referenced by switchName, which must start with a "-" sign. It can also be modified by setting values for resourceName and resourceClass in the X11 resource database. The init value string is used as a last resort to initialize the option if no other value can be used from an existing option, or queried from the X11 resource database. If any config code is specified, it is executed whenever the option is modified via the configure method. The config code can also be specified outside of the class definition via the configbody command. \par In the following example, a synthetic "-background" option is added to the class, so that whenever the background changes, the new value is reported to standard output. Note that this synthetic option is integrated with the rest of the "-background" options that have been kept from component widgets: \verbatim itcl::class MyWidget { inherit Widget constructor {args} { itk_component add label { label $itk_interior.l1 -text "Hello World!" } pack$itk_component(label) eval itk_initialize $args } itk_option define -background background Background #d9d9d9 { puts "new background:$itk_option(-background)" } } \endverbatim \b itk_option \b remove optName ?optName optName ...? \par Removes one or more options from the composite option list for a mega-widget. Here, optName can have one of the forms described above for the "itk_option add" command. \par Options are normally integrated into the composite option list when a component widget is first created. This method can be used to remove options at a later time. For example, a derived class can override an option defined in a base class by removing and redefining the option: \verbatim itcl::class Base { inherit itk::Widget constructor {args} { eval itk_initialize $args } itk_option define -foo foo Foo "" { puts "Base:$itk_option(-foo)" } } itcl::class Derived { inherit Base constructor {args} { itk_option remove Base::foo eval itk_initialize $args } itk_option define -foo foo Foo "" { puts "Derived:$itk_option(-foo)" } } \endverbatim \par Without the "itk_option remove" command, the code fragments for both of the "-foo" options would be executed each time the composite "-foo" option is configured. In the example above, the Base::foo option is suppressed in all Derived class widgets, so only the Derived::foo option remains. \par PROTECTED VARIABLES Derived classes can find useful information in the following protected variables. \b itk_component(name) \par Array variable containing all available components. The "itk_component" array returns the real window path name for a component widget with the symbolic name name. The same information can be queried using the component method, but accessing this array is faster and more convenient. \b itk_interior \par This variable contains the name of the window that acts as a parent for internal components. It is initialized to the name of the "hull" component provided by the Widget and Toplevel classes. Derived classes can override the initial setting to point to another interior window to be used for further-derived classes. \b itk_option(option) \par Array variable containing all available options. The "itk_option" array returns the current option value for the composite widget option named option. Here, the option name should include a leading "-" sign. The same information can be queried using the cget method, but accessing this array is faster and more convenient. \par KEYWORDS itk, Widget, Toplevel, mega-widget \par COPYRIGHT Copyright © 1989-1994 The Regents of the University of California. Copyright © 1994-1996 Sun Microsystems, Inc. Copyright © 2012-2012 Rene Zaumseil */ 

     > > > > > > > > > > >  1 2 3 4 5 6 7 8 9 10 11  PROJECT_NAME = "Itk" PROJECT_NUMBER = "4.0b1" OUTPUT_DIRECTORY= . INPUT = . ../library/Archetype.tcl FILE_PATTERNS = *.doc GENERATE_HTML = YES GENERATE_LATEX = NO GENERATE_MAN = NO MAN_EXTENSION = .n ALIASES += option{3}="Command-Line Name: \1
Database Name: \2
Database Class: \3
" ALIASES += component{2}="Name: \1
Class: \2
" 

     > > > > > > > > > > >  1 2 3 4 5 6 7 8 9 10 11  PROJECT_NAME = "Itk" PROJECT_NUMBER = "4.0b1" OUTPUT_DIRECTORY= . INPUT = . FILE_PATTERNS = *.doc GENERATE_HTML = NO GENERATE_LATEX = NO GENERATE_MAN = YES MAN_EXTENSION = .n ALIASES += option{3}="Command-Line Name: \1
Database Name: \2
Database Class: \3
" ALIASES += component{2}="Name: \1
Class: \2
" 

     > > > > > > > > > > >  1 2 3 4 5 6 7 8 9 10 11  PROJECT_NAME = "Itk" PROJECT_NUMBER = "4.0b1" OUTPUT_DIRECTORY= . INPUT = . ../library/Archetype.tcl FILE_PATTERNS = *.doc GENERATE_HTML = NO GENERATE_LATEX = YES GENERATE_MAN = NO MAN_EXTENSION = .n ALIASES += option{3}="Command-Line Name: \1
Database Name: \2
Database Class: \3
" ALIASES += component{2}="Name: \1
Class: \2
" 

     > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > >  1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115  /*! \page Toplevel Toplevel \par NAME Toplevel - base class for mega-widgets in a top-level window \par INHERITANCE itk::Archetype <- itk::Toplevel \par STANDARD OPTIONS \b backgroundcursor See the "options" manual entry for details on the standard options. \par WIDGET-SPECIFIC OPTIONS \option{title,Title,-title} \par Sets the title that the window manager displays in the title bar above the window. The default title is the null string. \par DESCRIPTION The Toplevel class inherits everything from the Archetype class, and adds a Tk toplevel called the "hull" component to represent the body of the mega-widget. The window class name for the hull is set to the most-specific class name for the mega-widget. The protected variable itk_interior contains the window path name for the "hull" component. Derived classes specialize this widget by packing other widget components into the hull. Since the hull for the Toplevel class is implemented with a Tk toplevel, mega-widgets in the Toplevel class have their own toplevel window. This class is used to create dialog boxes and other pop-up windows. \par COMPONENTS \component{hull,Toplevel} \par The "hull" component acts as the body for the entire mega-widget. Other components are packed into the hull to further specialize the widget. \par EXAMPLE The following example implements a MessageInfo mega-widget. It creates a pop-up message that the user can dismiss by pushing the "Dismiss" button. \verbatim option add *MessageInfo.title "Notice" widgetDefault itcl::class MessageInfo { inherit itk::Toplevel constructor {args} { itk_component add dismiss { button $itk_interior.dismiss -text "Dismiss" -command "destroy$itk_component(hull)" } pack $itk_component(dismiss) -side bottom -pady 4 itk_component add separator { frame$itk_interior.sep -height 2 -borderwidth 1 -relief sunken } pack $itk_component(separator) -side bottom -fill x -padx 4 itk_component add icon { label$itk_interior.icon -bitmap info } pack $itk_component(icon) -side left -padx 8 -pady 8 itk_component add infoFrame { frame$itk_interior.info } pack $itk_component(infoFrame) -side left -expand yes -fill both -padx 4 -pady 4 itk_component add message { label$itk_interior.mesg -width 20 } { usual rename -text -message message Text } pack $itk_component(message) -expand yes -fill both eval itk_initialize$args after idle [code $this centerOnScreen] } protected method centerOnScreen {} { update idletasks set wd [winfo reqwidth$itk_component(hull)] set ht [winfo reqheight $itk_component(hull)] set x [expr ([winfo screenwidth$itk_component(hull)]-$wd)/2] set y [expr ([winfo screenheight$itk_component(hull)]-$ht)/2] wm geometry$itk_component(hull) +$x+$y } } itk::usual MessageInfo { keep -background -cursor -foreground -font keep -activebackground -activeforeground -disabledforeground keep -highlightcolor -highlightthickness } # # EXAMPLE: Create a notice window: # MessageInfo .m -message "File not found:n/usr/local/bin/foo" \endverbatim \par KEYWORDS itk, Archetype, Widget, mega-widget \par COPYRIGHT Copyright © 1989-1994 The Regents of the University of California. Copyright © 1994-1996 Sun Microsystems, Inc. Copyright © 2012-2012 Rene Zaumseil */ 

     > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > >  1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109  /*! \page Widget Widget \par NAME Widget - base class for mega-widgets within a frame \par INHERITANCE itk::Archetype <- itk::Widget \par STANDARD OPTIONS \b backgroundcursor See the "options" manual entry for details on the standard options. \par DESCRIPTION The Widget class inherits everything from the Archetype class, and adds a Tk frame called the "hull" component to represent the body of the mega-widget. The window class name for the hull is set to the most-specific class name for the mega-widget. The protected variable itk_interior contains the window path name for the "hull" component. Derived classes specialize this widget by packing other widget components into the hull. Since the hull for the Widget class is implemented with a Tk frame, mega-widgets in the Widget class can be packed into other frames and toplevels. COMPONENTS \component{hull,Frame} \par The "hull" component acts as the body for the entire mega-widget. Other components are packed into the hull to further specialize the widget. \par EXAMPLE The following example implements a simple TextDisplay mega-widget. It creates a read-only display of text with a text widget and a scrollbar. \verbatim option add *TextDisplay.wrap none widgetDefault option add *TextDisplay.textBackground ivory widgetDefault option add *TextDisplay.width 40 widgetDefault option add *TextDisplay.height 10 widgetDefault itcl::class TextDisplay { inherit itk::Widget constructor {args} { itk_component add text { text $itk_interior.info -state disabled -yscrollcommand [code$itk_interior.sbar set] } { usual keep -tabs -wrap -width -height rename -background -textbackground textBackground Background } pack $itk_component(text) -side left -expand yes -fill both itk_component add scrollbar { scrollbar$itk_interior.sbar -command [code $itk_interior.info yview] } pack$itk_component(scrollbar) -side right -fill y eval itk_initialize $args } public method display {info} public method append {info} } itcl::body TextDisplay::display {info} {$itk_component(text) configure -state normal $itk_component(text) delete 1.0 end$itk_component(text) insert 1.0 $info$itk_component(text) configure -state disabled } itcl::body TextDisplay::append {info} { $itk_component(text) configure -state normal$itk_component(text) insert end $info$itk_component(text) configure -state disabled } itk::usual TextDisplay { keep -background -cursor -foreground -font keep -activebackground -activerelief keep -highlightcolor -highlightthickness keep -insertbackground -insertborderwidth -insertwidth keep -insertontime -insertofftime keep -selectbackground -selectborderwidth -selectforeground keep -textbackground -troughcolor } # # EXAMPLE: Display the /etc/passwd file # TextDisplay .file -background red pack .file .file display [exec cat /etc/passwd] \endverbatim \par KEYWORDS itk, Archetype, Widget, mega-widget \par COPYRIGHT Copyright © 1989-1994 The Regents of the University of California. Copyright © 1994-1996 Sun Microsystems, Inc. Copyright © 2012-2012 Rene Zaumseil */ 

     > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > >  1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65  /*! \mainpage Itcl only itk implementation \author Rene Zaumseil /itk4.0b1 \endverbatim \par Documentation To generate documentation you need the 'doxygen' program from doxygen.org. Change into the "doc/" subdirectory. To create html documentation in subdirectory "doc/html/" run: \verbatim doxygen \endverbatim To create pdf documentation in file "doc/latex/refman.pdf" run: \verbatim doxygen Doxyfile.pdf cd latex make \endverbatim To create man pages documentation in subdirectory "doc/man/" run: \verbatim doxygen Doxyfile.man \endverbatim \par License & support This work is under BSD license (see file 'license.terms') \par Acknowledgements This work is based on the original "incrTk" work at http://sf.net/projects/incrtcl/ and "incrTcl" 4 (starting at itcl-4-0-b8-rc) by Arnulf Wiedemann at http://core.tcl.tk/itcl/ */ 

     > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > >  1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75  /*! \page usual usual \par NAME usual - access default option-handling commands for a mega-widget component \par SYNOPSIS \b usual ?tag? ?commands? \par DESCRIPTION The \b usual command is used outside of an "itcl::class" definition to define the usual set of option-handling commands for a component widget. Option-handling commands are used when a component is registered with the Archetype base class via the "itk_component add" method. They specify how the component's configuration options should be integrated into the composite option list for the mega-widget. Options can be kept, renamed, or ignored, as described in the Archetype man page. It is tedious to include the same declarations again and again whenever components are added. The \b usual command allows a standard code fragment to be registered for each widget class, which is used by default to handle the options. All of the standard Tk widgets have \b usual declarations defined in the "itk" library. Similar usual declarations should be created whenever a new mega-widget class is conceived. Only the most-generic options should be included in the \b usual declaration. The \a tag name is usually the name of a widget class, which starts with a capital letter; however, any string registered here can be used later with the \b usual command described on the \ref Archetype man page. If the \a commands argument is specified, it is associated with the tag string, and can be accessed later via itk_component add. If only the tag argument is specified, this command looks for an existing tag name and returns the commands associated with it. If there are no commands associated with tag, this command returns the null string. If no arguments are specified, this command returns a list of all tag names previously registered. \par EXAMPLE Following is the \b usual declaration for the standard Tk button widget: \verbatim itk::usual Button { keep -background -cursor -foreground -font keep -activebackground -activeforeground -disabledforeground keep -highlightcolor -highlightthickness rename -highlightbackground -background background Background } \endverbatim Only the options that would be common to all buttons in a single mega-widget are kept or renamed. Options like "-text" that would be unique to a particular button are ignored. \par KEYWORDS itk, \ref Archetype, component, mega-widget \par COPYRIGHT Copyright © 1989-1994 The Regents of the University of California. Copyright © 1994-1996 Sun Microsystems, Inc. Copyright © 2012-2012 Rene Zaumseil */ 
     > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > >  1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713  ## Itcl only itk replacement. # # \file Archetype.tcl # \author Rene Zaumseil 3} { set myName [string range $myName 0 [incr myNr]]-[string range$myName [incr myNr] end] if {[info exists ::itk::option($myName)]} { set ::itk::option($myName) [lreplace $::itk::option($myName) 4 4 $body] return } } tailcall ::itk::configbody$name $body } #=============================================================================== ## Namespace containing tcl only itk features. namespace eval ::itk { ## Internal variable holding all usual informations. variable usual array set usual {} ## Access default option-handling commands for a mega-widget component. # # \param args ?tag? ?commands? # # Return sorted list of all provided usual tags: # \verbatim # usual # \endverbatim # # Return commands of given \a tag : # \verbatim # usual # \endverbatim # # Set commands of \a tag : # \verbatim # usual # \endverbatim # proc usual {args} { #puts "##usual$args" # keep, rename, ignore, usual -> see component options variable usual switch -- [llength $args] { 0 {return [lsort [array names usual]} 1 {if {[info exists usual($args)]} {return $usual($args)}} 2 {set usual([lindex $args 0]) [lindex$args 1]; return} default {error "wrong # of args, should be: usual ?tag? ?commands?"} } } #------------------------------------------------------------------------------- ## Internal variable holding all option informations. # \verbatim # ::itk::option(::::-) {-opt res cls init conf} # \endverbatim variable option array set option {} ## Command to work with class options. # # \param command define, add or remove # \param args additional arguments depending on given "command" # # Inside class definitions options can be defined with: # \verbatim # itk_option define switchName resourceName resourceClass init ?config? # \endverbatim # # The add and remove commands are available inside class methods: # \verbatim # itk_option add optName ?optName optName ...? # itk_option remove optName ?optName optName ...? # \endverbatim # proc ::itk_option {command args} { switch -- $command { define { switch -- [llength$args] { 4 {lappend args {}} 5 {} default {error "itk_option: wrong # args"} } set myOpt [lindex $args 0] if {[string index$myOpt 0] ne {-}} {error "itk_option: no switch name"} #TODO info frame set myTmp [dict get [::info frame [expr {[::info frame]-2}]] cmd] if {[lindex $myTmp 0] ni {::itcl::class itcl::class class}} {error "wrong itk_option define"} set myNs ::[string trimleft [lindex$myTmp 1] :] set ::itk::option(${myNs}::$myOpt) $args set myBody "set myNs${myNs}" append myBody { set myCls [string range $name 0 end-[expr {[string length$option]+2}]] if {$myCls eq${myNs}} { eval [lindex $::itk::option($name) 4] } else { nextto $myCls$name $option }} uplevel 1 [list public method itk_internal {name option}$myBody] } add {error "move to constructor"} remove {error "move to constructor"} default {error "wrong command '$command', should be one of add, define or remove"} } } } #=============================================================================== ## The Archetype class is the basis of all [itk] mega-widgets. # Provides facilities to merge widget options into a composite list of options # for the overall widget. # Derived classes add widgets and methods to specialize behavior. ::itcl::class itk::Archetype { ## Hook to store data. # This does not affect the widget operation in any way. # It is simply a hook that clients can use to store a bit of data with each # widget. # This can come in handy when using widgets to build applications. itk_option define -clientdata clientData ClientData "" ## Array variable containing all available components. # The "itk_component" array returns the real window path name for a component # widget with the symbolic name name. # The same information can be queried using the component method, but # accessing this array is faster and more convenient. protected variable itk_component ## This variable contains the name of the window that acts as a parent for # internal components. # It is initialized to the name of the "hull" component provided by the Widget # and Toplevel classes. # Derived classes can override the initial setting to point to another interior # window to be used for further-derived classes. protected variable itk_interior "" ## Array variable containing all available options. # The "itk_option" array returns the current option value for the composite # widget option named option. # Here, the option name should include a leading "-" sign. # The same information can be queried using the cget method, but accessing # this array is faster and more convenient. protected variable itk_option ## Array variable containing option definitions. # # \verbatim # _option(.opt) {-opt res cls init win -winopt} # _option(-opt) {::::opt|.opt ..} # \endverbatim private variable _option ## Original widget path of itk widget. private variable _path ## List of class options ready to set itk_option variable. # # \verbatim # - {list} .. # \endverbatim private common _classoptions ## Internal intepreter to parse option commands. private common _interp [interp create -safe --] ## Variable containing protected/public component names. protected variable _component ## Variable used in initialization of new objects. # The variable is set in the Archetype::constructor to all available options. # On initialization of options in the itk_initialize function these options # will be removed. Only remaining options in the outmost itk_initialize # call will then initialized with the 'option get' command protected variable _initialize #------------------------------------------------------------------------------- ## Build up itk infrastructure. # # \param args option value list to initialize object. # # First check on new class usages and initialize class related variables. # Then initialize all internal itk variables off the current object. # At least call the itk_initialize function. # constructor {args} { #puts "==$this [namespace current] itk::Archetype constructor $args" #TODO if {[string range$this 0 2] ne {::.}} {error "wrong _path name: $this"} # Build up available options of class set myClass [info class] # First check on new class usages and initialize class related variables. if {![::info exists _classoptions($myClass)]} { set myList [list $myClass ::itk::Archetype] set myNr 0 # Collect all involved classes while {1} { foreach c [::info class superclasses [lindex$myList $myNr]] { if {[lsearch$myList $c] == -1} {lappend myList$c} } if {[llength $myList] <= [incr myNr]} break } # Build standard initialization array set myOptions {} foreach c$myList { foreach myName [array names ::itk::option ${c}::-*] { set o [string range$myName [expr {[string length $c] + 2}] end] lappend myOptions($o) ${c}::$o } } set _classoptions($myClass) [array get myOptions] } # Then initialize all internal itk variables off the current object. array set itk_component {} set _component [list] array set itk_option {} array set _option$_classoptions($myClass) array set _initialize {} foreach o [array names _option -*] { set myName [lindex$_option($o) 0] set itk_option($o) [lindex $::itk::option($myName) 3] set _initialize($o) [lrange$::itk::option($myName) 1 2] } # At least call the itk_initialize function. itk_initialize {*}$args } #------------------------------------------------------------------------------- ## Cleanup object storage. destructor { #puts "==$this itk::Archetype destructor" destroy$_path } #------------------------------------------------------------------------------- ## Used to query or access component widgets within a mega-widget. # # \param args ?name? ?command arg arg ...? # # Invokes the given "command" as a method on the component called "name". # # \verbatim # pathName component ?name? ?command arg arg ...? # \endverbatim # public method component {args} { #puts "==$this component$args" switch -- [llength $args] { 0 {return$_component} 1 { if {[lsearch $_component$args] != -1} { return $itk_component($args) } } default { set myComp [lindex $args 0] if {$myComp eq {hull}} { $_path {*}[lrange$args 1 end] } elseif {[lsearch $_component$myComp] != -1} { $itk_component($myComp) {*}[lrange $args 1 end]} } } } #------------------------------------------------------------------------------- ## Returns the current value of the configuration option given by option. # # \param option Name of composite configuration option for the mega-widget # # Individual components integrate their own configuration options onto the # composite list when they are registered by the "itk_component add" method. public method cget {option} {return$itk_option($option)} #------------------------------------------------------------------------------- ## Query or modify the configuration options of the widget. # # \param args Option-value list to configure the widget # # Return list of all available configuration options: # \verbatim # pathName configure # \endverbatim # # Return information about given configuration option: # \verbatim # pathName configure ?option? # \endverbatim # # Set value of configuration options: # \verbatim # pathName configure ?option? ?value option value ...? # \endverbatim # public method configure {args} { set myNr [llength$args] if {$myNr == 0} { set myRet [list] foreach o [lsort [array names _option -*]] { lappend myRet [_option_info$o] } return $myRet } elseif {$myNr == 1} { return [_option_info $args] } elseif {$myNr%2 == 0} { foreach {o v} $args { set myOld$itk_option($o) set itk_option($o) $v if {[catch { foreach myName$_option($o) { if {[string index$myName 0] eq {:}} { $this itk_internal$myName $o } else { [lindex$_option($myName) 4] configure [lindex$_option($myName) 5]$v } } } myMsg]} { set itk_option($o)$myOld foreach myName1 $_option($o) { if {$myName1 eq$myName} break if {[string index $myName1 0] eq {:}} {$this itk_internal $myName1$o } else { [lindex $_option($myName1) 4] configure [lindex $_option($myName1) 5] $myOld } } error$myMsg } } return } error "value for '[lindex $args end]' missing" } ## See documentation of configure. public method config {args} {tailcall$this configure {*}$args} #------------------------------------------------------------------------------- ## This method must be invoked within the constructor for each class in a # mega-widget hierarchy. # # \param args ?option value option value...? # protected method itk_initialize {args} { #puts "==$this itk_initialize $args" if {[llength$args]} {configure {*}$args} foreach {o v}$args { unset -nocomplain _initialize($o) } if {[info class] == [uplevel 1 {namespace current}]} { set myArgs "" foreach o [array names _initialize] { set myIni [option get$itk_interior {*}$_initialize($o)] if {$myIni ne {}} { lappend myArgs$o $myIni } else { lappend myArgs$o $itk_option($o) } } unset -nocomplain _initialize if {[llength $myArgs]} {configure {*}$myArgs} } } #------------------------------------------------------------------------------- ## Command to work with class options. # # \param command One of add, remove or define # \param args Command related arguments # # \verbatim # itk_option add name ?name name ...? # \endverbatim # Adds the option "name" belonging to a class or component # widget into the option list. Options can be added even # if they were not originally kept when the component was # created. # # \verbatim # itk_option remove name ?name...? # \endverbatim # Removes the option "name" belonging to a class or component # widget from the option list. This allows a derived class # to turn off or redefine undesirable options inherited from # a base class. # protected method itk_option {command args} { switch -- $command { add {_option_add$args} remove {_option_remove $args} define {error "move to class definition"} default {error "usage"} } } #------------------------------------------------------------------------------- ## The method is used in derived classes as part of the implementation for a # mega-widget. # # \param command One of add or delete # \param args Command related arguments # # \verbatim # itk_component add ?-protected? ?-private? ?--? name createCmds ?optionCmds? # \endverbatim # Creates a component widget and merges its options into # the composite option list for the overall widget. # # \verbatim # itk_component delete name ?name name ...? # \endverbatim # Destroys a component widget and removes its options from # the composite option list. # protected method itk_component {command args} { #puts "==$this itk_component $command$args" switch -- $command { add {return [_component_add$args]} delete {_component_delete $args} default {error "wrong command '$command', should be add or delete"} } } #------------------------------------------------------------------------------- ## Build up option info list. # # \param option Name of option private method _option_info {option} { set myName [lindex $_option($option) 0] if {[string index $myName 0] eq {:}} { set l [lrange$::itk::option(${myName}) 0 3] lappend l$itk_option($option) } else { foreach {myOpt myRes myCls myIni myWin myNew}$_option($myName) break set l [list$myOpt $myRes$myCls $myIni [$myWin cget $myNew]] } return$l } ## Silent on found. # # \param list List of options to add private method _option_add {list} { #puts "$this ##_option_add$list" foreach myName $list { # Component .opt -> .opt set myNr [string last .$myName] if {$myNr > -1} { set myComp [string range$myName 0 [incr myNr -1]] set myOpt -[string range $myName [incr myNr 2] end] if {$myComp eq {hull}} {set myWin $_path} else {set myWin$itk_component($myComp)} set myVal [lsearch -index 0 -inline [$myWin configure] $myOpt] if {[llength$myVal] != 5} { error "component option name '$myName' not found\n$myWin [winfo class $myWin]\n[join [$myWin configure] \n]" } set myIni [lindex $myVal 4] set myVal [lrange$myVal 0 3] lappend myVal $myWin$myOpt set _option($myName)$myVal if {[::info exists _option($myOpt)]} { if {[lsearch$_option($myOpt)$myName] == -1} { lappend _option($myOpt)$myName } continue } set _option($myOpt)$myName set itk_option($myOpt)$myIni if {![info exists _initialize($myOpt)]} { set _initialize($myOpt) [lrange $myVal 1 2] } continue } # Class ::opt -> ::::-opt set myNr [string last ::$myName] if {$myNr > -1} { if {[string range$myName 0 1] ne {::}} { set myName ::$myName incr myNr 2 } set myClass [string range$myName 0 [incr myNr -1]] set myOpt -[string range $myName [incr myNr 3] end] set myName${myClass}::$myOpt if {![::info exists$::itk::option($myName)]} { error "class option name '$myName' not found" } if {[::info exists _option($myOpt)]} { if {[lsearch$_option($myOpt)$myName] == -1} { lappend _option($myOpt)$myName } continue } set _option($myOpt)$myName set itk_option($myOpt) [lindex$::itk::option($myName) 3] if {![info exists _initialize($myOpt)]} { set _initialize($myOpt) [lrange$::itk::option($myName) 1 2] } continue } error "option name '$myName' not found" } } #------------------------------------------------------------------------------- ## Silent on not found. # # \param list List of option to remove # private method _option_remove {list} { #puts "##_option_remove $list\n[parray _option]" foreach myName$list { set myNr [string last . $myName] if {$myNr > -1} { set myComp [string range $myName 0 [incr myNr -1]] set myOpt -[string range$myName [incr myNr 2] end] set myNr [lsearch $_option($myOpt) $myName] if {$myNr == -1} continue unset _option($myName) set _option($myOpt) [lreplace $_option($myOpt) $myNr$myNr] if {[llength $_option($myOpt)] == 0} { unset _option($myOpt) unset itk_option($myOpt) unset -nocomplain _initialize($myOpt) } continue } set myNr [string last ::$myName] if {$myNr > -1} { if {[string range$myName 0 1] ne {::}} { set myName ::$myName incr myNr 2 } set myClass [string range$myName 0 [incr myNr -1]] set myOpt -[string range $myName [incr myNr 3] end] set myName${myClass}::$myOpt set myNr [lsearch$_option($myOpt)$myName] if {$myNr == -1} continue set _option($myOpt) [lreplace $_option($myOpt) $myNr$myNr] if {[llength $_option($myOpt)] == 0} { unset _option($myOpt) unset itk_option($myOpt) unset -nocomplain _initialize($myOpt) } continue } } } #------------------------------------------------------------------------------- ## Add new component. # # \param list Component add statement # # Recognized commands: # - ignore option ?option option ...? # - keep option ?option option ...? # - rename option switchName resourceName resourceClass # - usual ?tag? private method _component_add {list} { #puts "$this ##_component_add $list" set myLevel public set i 0 foreach mySwitch$list { switch -- $mySwitch { -protected {set myLevel protected;incr i} -private {set myLevel private;incr i} -- {incr i; break} default { if {[string index$mySwitch 0] eq {-}} { error "bad option \"$mySwitch\": should be -private, -protected or --" } break } } } if {$i} {set list [lrange $list$i end]} if {[llength $list] == 1} { error {wrong # args: should be "itk_component add ?-protected? ?-private? ?--? name createCmds ?optionCmds?"} } if {[llength$list] > 3} { error {wrong # args: should be "add ?-protected? ?-private? ?--? name createCmds ?optionCmds?"} } foreach {myComp myCmd myOpts} $list break if {[::info exists itk_component($myComp)]} { error "component '$myComp' already exists\n[parray itk_component]\n[parray _option]" } # Check on special 'hull' component. if {$myComp eq {hull}} { set myThis ::[namespace tail $this] rename$this ::itk::tmp$myThis } # Create new widget. set itk_component($myComp) [uplevel 2 $myCmd] if {$myLevel ne {private}} { lappend _component $myComp # set _component [lsort$_component] } # Check on special 'hull' component. if {$myComp eq {hull}} { set _path .itk$itk_component(hull) rename $itk_component(hull)$_path rename ::itk::tmp$myThis$myThis } else { # Remove widget options if destroyed set myList [bindtags $itk_component($myComp)] bind itk-destroy-$itk_component($myComp) [itcl::code $this itk_component delete$myComp] bindtags $itk_component($myComp) [list itk-destroy-$itk_component($myComp) {*}$myList] } set myTag [winfo class$itk_component($myComp)] if {$myOpts eq {}} {set myOpts usual} # catch in ignore() because of not defined options in p.e. scrolledtext interp eval $_interp { array set ::result {} proc rename {args} {set ::result([lindex$args 0]) [lrange $args 1 end]} proc keep {args} {foreach o$args {set ::result($o) {}}} proc ignore {args} {foreach o$args {catch {unset ::result($o)}}} } interp eval$_interp "proc usual {{tag {$myTag}}} {eval $::itk::usual \tag$}" interp alias$_interp ::itk::usual {} ::itk::usual interp eval $_interp$myOpts foreach {myOpt myArgs} [interp eval $_interp {array get ::result}] { if {$myArgs eq {}} {;# add single option _option_add $myComp.[string range$myOpt 1 end] } else {;# rename option switchName resourceName resourceClass if {[llength $myArgs] != 3} {error "wrong rename args"} if {$myComp eq {hull}} {set myWin $_path} else {set myWin$itk_component($myComp)} # check window option set myVal [lsearch -index 0 -inline [$myWin configure] $myOpt] if {[llength$myVal] != 5} {error "component option rename '$myOpt$myArgs' not found\n$myVal"} #TODO test set myNew [lindex$myArgs 0] if {[string index $myNew 0] ne {-}} {error "component wrong switch '$myOpt $myArgs'"} lappend myArgs [lindex$myVal 3] $myWin$myOpt set myName $myComp.[string range$myNew 1 end] set _option($myName)$myArgs if {![info exists _option($myNew)]} { set itk_option($myNew) [lindex $myVal 4] } lappend _option($myNew) $myName } } interp eval$_interp {catch {unset ::result}} return $myComp } #------------------------------------------------------------------------------- ## Delete all given components. # # \param list List of component names # private method _component_delete {list} { #puts "## _component_delete$list" foreach myName $list { if {![::info exists itk_component($myName)]} {error "component '$myName' does not exist"} _option_remove [array names _option$myName.*] ::itk::remove_destroy_hook $itk_component($myName) unset itk_component($myName) set myNr [lsearch$_component $myName] if {$myNr != -1} { set _component [lreplace $_component$myNr $myNr] } } } #------------------------------------------------------------------------------- } #===============================================================================  Added library/Toplevel.tcl.      > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > >  1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83  # # itk::Toplevel # ---------------------------------------------------------------------- # Base class for toplevel windows in the [incr Tk] Toolkit. Creates # a new toplevel window to contain the widget. Derived classes add # widgets and methods to specialize behavior. # # WIDGET ATTRIBUTES: # switch: -background .... normal background color for widget # name: background # class: Background # # switch: -cursor ........ cursor for widget # name: cursor # class: Cursor # # switch: -title ......... title given to window manager # name: title # class: Title # # ---------------------------------------------------------------------- # AUTHOR: Michael J. McLennan # Bell Labs Innovations for Lucent Technologies # mmclennan@lucent.com # http://www.tcltk.com/itcl # # ---------------------------------------------------------------------- # Copyright (c) 1993-1998 Lucent Technologies, Inc. # ====================================================================== # See the file "license.terms" for information on usage and # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. itcl::class itk::Toplevel { inherit itk::Archetype constructor {args} { # # Create a toplevel window with the same name as this object # set itk_hull [namespace tail$this] set itk_interior $itk_hull itk_component add hull { toplevel$itk_hull -class [namespace tail [info class]] } { keep -menu -background -cursor -takefocus } bind itk-delete-$itk_hull [list itcl::delete object$this] set tags [bindtags $itk_hull] bindtags$itk_hull [linsert $tags 0 itk-delete-$itk_hull] eval itk_initialize $args } destructor { if {[winfo exists$itk_hull]} { set tags [bindtags $itk_hull] set i [lsearch$tags itk-delete-$itk_hull] if {$i >= 0} { bindtags $itk_hull [lreplace$tags $i$i] } destroy $itk_hull } itk_component delete hull set components [component] foreach component$components { set path($component) [component$component] } foreach component $components { if {[winfo exists$path($component)]} { destroy$path($component) } } } itk_option define -title title Title "" { wm title$itk_hull $itk_option(-title) } private variable itk_hull "" }  Added library/Widget.tcl.      > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > >  1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80  # # itk::Widget # ---------------------------------------------------------------------- # Base class for ordinary widgets in the [incr Tk] Toolkit. Creates # a frame to contain the widget. Derived classes add widgets and # methods to specialize behavior. # # METHODS: # # WIDGET ATTRIBUTES: # switch: -background .... normal background color for widget # name: background # class: Background # # switch: -cursor ........ cursor used when pointer is inside # name: cursur widget # class: Cursur # # ---------------------------------------------------------------------- # AUTHOR: Michael J. McLennan # Bell Labs Innovations for Lucent Technologies # mmclennan@lucent.com # http://www.tcltk.com/itcl # # ---------------------------------------------------------------------- # Copyright (c) 1993-1998 Lucent Technologies, Inc. # ====================================================================== # See the file "license.terms" for information on usage and # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. itcl::class itk::Widget { inherit itk::Archetype # ------------------------------------------------------------------ # CONSTRUCTOR # ------------------------------------------------------------------ constructor {args} { # # Create a window with the same name as this object # set itk_hull [namespace tail$this] set itk_interior $itk_hull itk_component add hull { frame$itk_hull -class [namespace tail [info class]] } { keep -background -cursor } bind itk-delete-$itk_hull [list itcl::delete object$this] set tags [bindtags $itk_hull] bindtags$itk_hull [linsert $tags 0 itk-delete-$itk_hull] eval itk_initialize $args } destructor { if {[winfo exists$itk_hull]} { set tags [bindtags $itk_hull] set i [lsearch$tags itk-delete-$itk_hull] if {$i >= 0} { bindtags $itk_hull [lreplace$tags $i$i] } destroy $itk_hull } itk_component delete hull set components [component] foreach component$components { set path($component) [component$component] } foreach component $components { if {[winfo exists$path($component)]} { destroy$path($component) } } } private variable itk_hull "" }  Added library/itk.tcl.      > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > >  1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144  # # itk.tcl # ---------------------------------------------------------------------- # Invoked automatically upon startup to customize the interpreter # for [incr Tk]. # ---------------------------------------------------------------------- # AUTHOR: Michael J. McLennan # Bell Labs Innovations for Lucent Technologies # mmclennan@lucent.com # http://www.tcltk.com/itcl # # ---------------------------------------------------------------------- # Copyright (c) 1993-1998 Lucent Technologies, Inc. # ====================================================================== # See the file "license.terms" for information on usage and # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. # ---------------------------------------------------------------------- # USAGE: itk::remove_destroy_hook # # Used internally via "itk_component delete" when disconnecting a # component from the mega-widget that contains it. # Each component has a special binding for the event # that causes it to disconnect itself from its parent when destroyed. # This procedure removes the binding from the binding tag list and # deletes the binding. It is much easier to implement this in # Tcl than C. # ---------------------------------------------------------------------- proc ::itk::remove_destroy_hook {widget} { if {![winfo exists$widget]} {return} set tags [bindtags $widget] set i [lsearch$tags "itk-destroy-$widget"] if {$i >= 0} { bindtags $widget [lreplace$tags $i$i] } bind itk-destroy-$widget {} } # # Define "usual" option-handling code for the Tk widgets: # itk::usual Button { keep -background -cursor -foreground -font keep -activebackground -activeforeground -disabledforeground keep -highlightcolor -highlightthickness rename -highlightbackground -background background Background } itk::usual Canvas { keep -background -cursor keep -insertbackground -insertborderwidth -insertwidth keep -insertontime -insertofftime keep -selectbackground -selectborderwidth -selectforeground keep -highlightcolor -highlightthickness rename -highlightbackground -background background Background } itk::usual Checkbutton { keep -background -cursor -foreground -font keep -activebackground -activeforeground -disabledforeground keep -selectcolor keep -highlightcolor -highlightthickness rename -highlightbackground -background background Background } itk::usual Entry { keep -background -cursor -foreground -font keep -insertbackground -insertborderwidth -insertwidth keep -insertontime -insertofftime keep -selectbackground -selectborderwidth -selectforeground keep -highlightcolor -highlightthickness rename -highlightbackground -background background Background } itk::usual Frame { keep -background -cursor } itk::usual Label { keep -background -cursor -foreground -font keep -highlightcolor -highlightthickness rename -highlightbackground -background background Background } itk::usual Listbox { keep -background -cursor -foreground -font keep -selectbackground -selectborderwidth -selectforeground keep -highlightcolor -highlightthickness rename -highlightbackground -background background Background } itk::usual Menu { keep -background -cursor -foreground -font keep -activebackground -activeforeground -disabledforeground keep -selectcolor -tearoff } itk::usual Menubutton { keep -background -cursor -foreground -font keep -activebackground -activeforeground -disabledforeground keep -highlightcolor -highlightthickness rename -highlightbackground -background background Background } itk::usual Message { keep -background -cursor -foreground -font keep -highlightcolor -highlightthickness rename -highlightbackground -background background Background } itk::usual Radiobutton { keep -background -cursor -foreground -font keep -activebackground -activeforeground -disabledforeground keep -selectcolor keep -highlightcolor -highlightthickness rename -highlightbackground -background background Background } itk::usual Scale { keep -background -cursor -foreground -font -troughcolor keep -activebackground keep -highlightcolor -highlightthickness rename -highlightbackground -background background Background } itk::usual Scrollbar { keep -background -cursor -troughcolor keep -activebackground -activerelief keep -highlightcolor -highlightthickness rename -highlightbackground -background background Background } itk::usual Text { keep -background -cursor -foreground -font keep -insertbackground -insertborderwidth -insertwidth keep -insertontime -insertofftime keep -selectbackground -selectborderwidth -selectforeground keep -highlightcolor -highlightthickness rename -highlightbackground -background background Background } itk::usual Toplevel { keep -background -cursor }  Added library/pkgIndex.tcl.      > > > > > > > > >  1 2 3 4 5 6 7 8 9  package ifneeded itk 4.0 " package req Tk 8.6 package req itcl 4 source [file join$dir Archetype.tcl] source [file join $dir Toplevel.tcl] source [file join$dir Widget.tcl] source [file join \$dir itk.tcl] package provide itk 4.0 " 
     > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > >  1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42  This software is copyrighted by Rene Zaumseil (the maintainer). The following terms apply to all files associated with the software unless explicitly disclaimed in individual files. This software is copyrighted by Lucent Technologies, Inc., and other parties. The following terms apply to all files associated with the software unless explicitly disclaimed in individual files. The authors hereby grant permission to use, copy, modify, distribute, and license this software and its documentation for any purpose, provided that existing copyright notices are retained in all copies and that this notice is included verbatim in any distributions. No written agreement, license, or royalty fee is required for any of the authorized uses. Modifications to this software may be copyrighted by their authors and need not follow the licensing terms described here, provided that the new terms are clearly indicated on the first page of each file where they apply. IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. GOVERNMENT USE: If you are acquiring this software on behalf of the U.S. government, the Government shall have only "Restricted Rights" in the software and related documentation as defined in the Federal Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you are acquiring the software on behalf of the Department of Defense, the software shall be classified as "Commercial Computer Software" and the Government shall have only "Restricted Rights" as defined in Clause 252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the authors grant the U.S. Government and others acting in its behalf permission to use and distribute the software in accordance with the terms specified in this license.